home *** CD-ROM | disk | FTP | other *** search
/ System Booster / System Booster.iso / Archives / ARexxTools / fpl70.lha / src / numexpr.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-03-17  |  85.0 KB  |  2,551 lines
  1. /******************************************************************************
  2.  *                        FREXX PROGRAMMING LANGUAGE                          *
  3.  ******************************************************************************
  4.  
  5.  numexpr.c
  6.  
  7.  Supports *FULL* C language expression operator priority and much more...!
  8.  
  9.  *****************************************************************************/
  10.  
  11. /************************************************************************
  12.  *                                                                      *
  13.  * fpl.library - A run time library interpreting script langauge.       *
  14.  * Copyright (C) 1992, 1993 FrexxWare                                   *
  15.  * Author: Daniel Stenberg                                              *
  16.  *                                                                      *
  17.  * This program is free software; you can redistribute it and/or modify *
  18.  * it under the terms of the GNU General Public License as published by *
  19.  * the Free Software Foundation; either version 2, or (at your option)  *
  20.  * any later version.                                                   *
  21.  *                                                                      *
  22.  * This program is distributed in the hope that it will be useful,      *
  23.  * but WITHOUT ANY WARRANTY; without even the implied warranty of       *
  24.  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the        *
  25.  * GNU General Public License for more details.                         *
  26.  *                                                                      *
  27.  * You should have received a copy of the GNU General Public License    *
  28.  * along with this program; if not, write to the Free Software          *
  29.  * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.            *
  30.  *                                                                      *
  31.  * Daniel Stenberg                                                      *
  32.  * Birger Jarlsgatan 93b 3tr                                            *
  33.  * 113 56 Stockholm                                                     *
  34.  * Sweden                                                               *
  35.  *                                                                      *
  36.  * FidoNet 2:201/328      email: dast@sth.frontec.se                    *
  37.  *                                                                      *
  38.  ************************************************************************/
  39.  
  40. #ifdef AMIGA
  41. #include <exec/types.h>
  42. #include <proto/exec.h>
  43. #include <stdlib.h> /* for the atoi() prototype */
  44. #elif defined(UNIX)
  45. #include <sys/types.h>
  46. #endif
  47.  
  48. #include "script.h"
  49. #include <stdio.h>
  50. #include <stddef.h>
  51. #include <limits.h>
  52.  
  53. static ReturnCode AddUnary(struct Data *, struct Expr *, Operator);
  54. static ReturnCode INLINE Calc(struct Data *, struct Expr *, struct Expr *);
  55. static void INLINE HandleString(struct Data *, struct Expr *);
  56. static ReturnCode INLINE GetArrayInfo(struct Data *, long *, long *, long);
  57. static ReturnCode INLINE Convert(struct Expr *, struct Data *);
  58. static void INLINE Clean(struct Data *, struct Expr *);
  59. static long ArrayNum(long, long, long *, long *);
  60. static ReturnCode INLINE CallFunction(struct Data *, struct fplArgument *,
  61.                                       struct Identifier *);
  62. static ReturnCode INLINE PrototypeInside(struct Data *,
  63.                      struct Expr *val,
  64.                      long,
  65.                      struct Identifier *);
  66. static ReturnCode INLINE inside(struct Data *, struct fplArgument *,
  67.                                 struct Identifier *);
  68. static ReturnCode INLINE StringToStack(struct Data *,
  69.                                        struct fplStr **);
  70. static ReturnCode INLINE StringFromStack(struct Data *,
  71.                                          struct fplStr **);
  72.  
  73. /***********************************************************************
  74.  *
  75.  * int Expression(struct Expr *, struct Data *, char, struct Local *)
  76.  *
  77.  * Returns a nonzero value if any error occured.
  78.  * The result of the Expression is returned in the Expr structure which you
  79.  * give the pointer to in the first argument.
  80.  *
  81.  *****************/
  82.  
  83. ReturnCode
  84. Expression(struct Expr *val, /* return value struct pointer */
  85.            struct Data *scr, /* everything */
  86.            long control,    /* ESPECIALLLY DEFINED */
  87.            struct Identifier *ident) /* pointer to the pointer holding
  88.                                         the local variable names linked
  89.                                         list */
  90. {
  91.   struct Expr *expr, *basexpr;
  92.   ReturnCode ret;
  93.   struct Identifier *pident; /* general purpose struct identifier pointer */
  94.   struct Unary *un; /* general purpose struct Unary pointers */
  95.   long *dims=NULL; /* dimension pointer for variable arrays! */
  96.   long pos;       /* general purpose integer */
  97.   char *text;     /* general purpose char pointer */
  98.   char hit;
  99.   char *array;
  100.   long num;
  101.   char conditional=0; /* The first bit FPLBIT_CONDITIONAL should be set if
  102.                          a '?' has been parsed, which allows a ':' to be
  103.                          parsed as a valid operator. */
  104.   struct fplMsg *msg;
  105.   struct fplStr *string;
  106. #if defined(AMIGA) && defined(SHARED)
  107.   if(ret=CheckStack(scr, scr->stack_limit, FPLSTACK_MINIMUM)) {
  108.     if(ret==1)
  109.       return(FPLERR_OUT_OF_MEMORY);
  110.     else
  111.       return(FPLERR_OUT_OF_STACK);
  112.   }
  113. #endif
  114.   
  115.   GETMEM(expr, sizeof(struct Expr));
  116.   memset(expr, 0, sizeof(struct Expr));
  117.   basexpr=expr;
  118.   
  119.   while (1) {
  120.     if(ret=Eat(scr)) {       /* getaway blanks and comments */
  121.       if(control&CON_END && ret==FPLERR_UNEXPECTED_END) {
  122.         /* If there can be an unexpected ending, break out of the loop
  123.            with a nice return code! */
  124.         break;
  125.       }
  126.     } else if(expr->flags&FPL_STRING && !(control&CON_GROUNDLVL))
  127.       /* get outta string calcs if not on ground level! */
  128.       break;
  129.     
  130.     if(!(expr->flags&FPL_OPERAND)) {  /* operand coming up */
  131.       if(control&CON_IDENT ||
  132.          ALPHA(*scr->text)) {
  133.         /*
  134.          * It's a valid identifier character.
  135.          */
  136.         char *point;
  137.         num=0; /* Dimension counter when taking care of array variables */
  138.         
  139.         
  140.         if(control&CON_IDENT) {
  141.           if(!ident)
  142.             ret=FPLERR_IDENTIFIER_NOT_FOUND;
  143.           control&=~CON_IDENT; /* switch off that bit to get away from any
  144.                                   trouble such as double using this! */
  145.         } else {
  146.           CALL(Getword(scr->buf, scr));
  147.           ret=GetIdentifier(scr, scr->buf, &ident);
  148.           if(scr->compiling)
  149.             COMPILESYMBOL(scr->buf);
  150.         }
  151.  
  152.         point=scr->text;
  153.         Eat(scr); /* getaway blanks */
  154.           
  155.         /*
  156.          * `ret' can only be FPL_OK or FPLERR_IDENTIFIER_NOT_FOUND at this
  157.          * position.
  158.          */
  159.         
  160.         if(control&CON_DECLARE && *scr->text==CHAR_OPEN_PAREN) {
  161.       CALL(PrototypeInside(scr, val, control, ident));
  162.       expr->flags|=FPL_OPERAND|FPL_ACTION;
  163.  
  164.         } else if(control&CON_DECLARE ||
  165.                   (ident && ident->flags&FPL_VARIABLE)) {
  166.           /* The ident check above really must be there, otherwise we might
  167.              read it when it is a NULL pointer" */
  168.           
  169.           /* it's a variable */
  170.           pident=ident;
  171.           if(ret &&                     /* we didn't find it... */
  172.              !(control&CON_DECLARE))    /* and we're not declaring! or */
  173.             /*
  174.              * We didn't find the requested identifier and we're *NOT*
  175.              * declaring. This means error!
  176.              */
  177.             return(ret);
  178.           else if(!ret) {
  179.             /* The symbol was found */
  180.             if(control&CON_DECLARE && (ident->level>=scr->varlevel ||
  181.                        scr->varlevel==1)) {
  182.               /*
  183.                * If the name already declared in this (or higher) level
  184.                * and declaration is wanted.
  185.                */
  186.               if((ident->flags&FPL_STATIC_VARIABLE &&
  187.                   control&CON_DECLSTATIC &&
  188.                   ident->level==scr->varlevel) ||
  189.                  /*
  190.                   * If this is a `static' variable and the variable already
  191.                   * exists on this very level in this very function as static,
  192.                   * then skip this. It's perfectly OK to jump to the ending
  193.                   * semicolon since this has been parsed before!
  194.                   */
  195.                  
  196.                  (ident->flags&FPL_EXPORT_SYMBOL && control&CON_DECLEXP)) {
  197.                 
  198.                 /*
  199.                  * If this is an `export' symbol and it already exists as an
  200.                  * `export' symbol! Then just ignore this!
  201.                  */
  202.                 
  203.                 /*
  204.                  * The current implementation unfortunately uses the statement
  205.                  * below to pass this declaration. That means comma-
  206.                  * separated exported symbols will be passed if only the first
  207.                  * is alredy declared... This will although work in all those
  208.                  * cases it is the SAME code that is executed twice!
  209.                  */
  210.                 
  211.                 
  212.                 CALL(GetEnd(scr, CHAR_SEMICOLON, 255, FALSE));
  213.                 scr->text--; /* get back on the semicolon! */
  214.                 break;
  215.               } else {
  216.                 CALL(Warn(scr, FPLERR_IDENTIFIER_USED));
  217.                 /* run it over! */
  218.                 DelIdentifier(scr, ident->name, NULL);
  219.               }
  220.             } else if(!(control&CON_DECLARE) &&
  221.                       (ident->level && /* not global */
  222.                        ident->level<(scr->varlevel-scr->level)))
  223.               /*
  224.                * From the wrong program level and we're not declaring.
  225.                */
  226.               return(FPLERR_IDENTIFIER_NOT_FOUND);
  227.             else if(ident->flags&FPL_STATIC_VARIABLE &&
  228.                     ((ident->func && (ident->func==scr->func)) ||
  229.                      ident->level>scr->varlevel)
  230.                     )
  231.               /*
  232.                * A static variable declared either in the wrong function or
  233.                * in a higher level!
  234.                */
  235.               return(FPLERR_IDENTIFIER_NOT_FOUND);
  236.           }
  237.           if(*scr->text==CHAR_OPEN_BRACKET) {
  238.             /*
  239.              * It's an array. Get the result of the expression within the
  240.              * square brackets.
  241.              */
  242.             
  243.             if(!dims) {
  244.               GETMEM(dims, MAX_DIMS*sizeof(long));
  245.             }
  246.             if(!(control&CON_DECLARE) && pident->data.variable.size)
  247.               num=pident->data.variable.num;
  248.             if(control&CON_DECLARE || num) {
  249.               CALL(GetArrayInfo(scr, dims, &num, control));
  250.               if(!(control&CON_DECLARE)) {
  251.                 if(num>pident->data.variable.num) {
  252.                   /*
  253.                    * If not declaring and overfilled quota: fail!
  254.                    */
  255.                   CALL(Warn(scr, FPLERR_ILLEGAL_ARRAY));
  256.                   /* force to no more dims than declared! */
  257.                   num=pident->data.variable.num;
  258.                 } else {
  259.                   for(pos=0; pos<num; pos++)
  260.                     if(pident->data.variable.dims[pos]<=dims[pos]) {
  261.                       CALL(Warn(scr, FPLERR_ILLEGAL_ARRAY));
  262.                       /* force to no more than declared! */
  263.                       pident->data.variable.dims[pos]=dims[pos]-1;
  264.                     }
  265.                 }
  266.               }
  267.               point=scr->text; /* move point to current location  */
  268.               Eat(scr); /* pass all traling whitespaces */
  269.             }
  270.           }
  271.           if(control&CON_DECLARE) {
  272.             expr->flags|=FPL_ACTION;
  273.             GETMEM(pident, sizeof(struct Identifier));
  274.             
  275.             pident->level=
  276.               (control&(CON_DECLEXP|CON_DECLGLOB))?0:scr->varlevel;
  277.             pident->flags=
  278.               (control&CON_DECLINT?FPL_INT_VARIABLE:FPL_STRING_VARIABLE)|
  279.                 (control&CON_DECLEXP?FPL_EXPORT_SYMBOL:0)|
  280.                   (control&CON_DECLGLOB?FPL_GLOBAL_SYMBOL:0)|
  281.                     (control&CON_DECL8?FPL_CHAR_VARIABLE:
  282.                      (control&CON_DECL16?FPL_SHORT_VARIABLE:0))|
  283.                        (control&CON_DECLCONST?FPL_READONLY:0)|
  284.                          (control&CON_DECLSTATIC?FPL_STATIC_VARIABLE:0);
  285.             
  286.             pident->file=control&CON_DECLEXP?NULL:scr->prog->name; /* file */
  287.             
  288.             pident->func=scr->func; /* declared in this function */
  289.  
  290.             /* Get memory for the variable name */
  291.             STRDUP(pident->name, scr->buf); /* no real strdup */
  292.             
  293.             if(num) {
  294.               /*
  295.                * Array variable declaration! It is a bit different from
  296.                * common variable declaration so I decided to put the code
  297.                * for it right here:
  298.                */
  299.               long size=dims[0]; /* array size */
  300.               
  301.               for(pos=1; pos<num; pos++)
  302.                 size*=dims[pos];
  303.               
  304.               /* Now `size' is the total number of members in the array we're
  305.                  about to declare */
  306.               
  307.               /* Get memory for the dimension array */
  308.               GETMEM(pident->data.variable.dims, num * sizeof(long));
  309.               
  310.               /* Copy the dim info to the newly allocated area */
  311.               memcpy((void *)pident->data.variable.dims, dims, num*sizeof(long));
  312.               
  313.               /* Get memory for the array  */
  314.               GETMEM(pident->data.variable.var.val32, size * sizeof(long));
  315.               
  316.               /* Set all string lengths to NULL and integers to zero: */
  317.               memset(pident->data.variable.var.val32, 0, size * sizeof(void *));
  318.               
  319.               pident->data.variable.size=size; /* total number of array members */
  320.               pident->data.variable.num=num;   /* number of dimensions */
  321.               
  322.               /* reset the dims array! */
  323.               memset((void *)dims, 0, sizeof(long) * num);
  324.               
  325.               /* reset num: */
  326.               num=1;
  327.               
  328.             } else {
  329. #ifdef DEBUG
  330.               CheckMem(scr, pident);
  331. #endif
  332.               
  333.               GETMEM(pident->data.variable.var.val32, sizeof(long));
  334.               *pident->data.variable.var.val32=0;
  335.               pident->data.variable.num=0;
  336.               pident->data.variable.size=1;
  337.             }
  338.             /*
  339.              * We add the symbol to the local data in all cases except when
  340.              * the symbol is global or static.
  341.              */
  342.             CALL(AddVar(scr, pident,
  343.                         control&(CON_DECLGLOB|CON_DECLSTATIC)?
  344.                         &scr->globals:&scr->locals));
  345.           }
  346.           
  347.           /*
  348.            * Now when all declarations is done, all assigns are left:
  349.            */
  350.           
  351.           expr->flags|=FPL_OPERAND;
  352.           if (pident->flags&FPL_STRING_VARIABLE) { /* string variable */
  353.             if(*scr->text==CHAR_OPEN_BRACKET) { /* just one character */
  354.               /*
  355.                * Get the result of the expression.
  356.                */
  357.               char *value;
  358.               if(scr->compiling)
  359.                 COMPILE(COMP_ARRAY);
  360.               CALL(Expression(val, (scr->text++, scr),
  361.                               CON_GROUNDLVL|CON_NUM, NULL));
  362.               if(*scr->text!=CHAR_CLOSE_BRACKET) {
  363.                 CALL(Warn(scr, FPLERR_MISSING_BRACKET));
  364.                 /* we can continue anyway! */
  365.               } else
  366.                 scr->text++;
  367.  
  368.               if(&pident->data.variable.var.str[num] &&
  369.                  (val->val.val >= pident->data.variable.var.str[num]->len)) {
  370.                 /* force to zero! */
  371.                 val->val.val=0;
  372.               } else if(val->val.val<0) {
  373.                 CALL(Warn(scr, FPLERR_OUT_OF_REACH));
  374.                 /* force zero! */
  375.                 val->val.val=0;
  376.               }
  377.               
  378.               /*
  379.                * (I) Here we should be able to operate the character read
  380.                * from the string. ++ and -- should work to enable advanced
  381.                * string modification handling without the
  382.                * overhead of getting the string, changing it and then re-
  383.                * assign it back. This *MUST* be implemented soon cause
  384.                * it's a real killer!
  385.                */
  386.  
  387.               value=(char *)&pident->data.variable.var.str[num]->string[val->val.val];
  388.               
  389.               if(ASSIGN_OPERATOR) {
  390.                 char was=*scr->text;
  391.                 long valint=*value;
  392.                 expr->flags|=FPL_ACTION;
  393.                 if(*scr->text==CHAR_ASSIGN)
  394.                   scr->text++;
  395.                 else if(scr->text[2]==CHAR_ASSIGN)
  396.                   scr->text+=3;
  397.                 else
  398.                   scr->text+=2;
  399.                 /* single assign */
  400.                 CALL(Expression(val, scr, CON_NORMAL|CON_NUM, NULL));
  401.                 CALL(CmpAssign(scr, val->val.val, &valint, FPL_CHAR_VARIABLE, was));
  402.                 *value=valint;
  403.               }
  404.               
  405.               expr->val.val=*value; /* only one byte */
  406.               CALL(NewMember(scr, &expr));
  407.             } else if(control&CON_NUM) {
  408.               /* NO strings allowed! */
  409.               CALL(Warn(scr, FPLERR_ILLEGAL_STATEMENT));
  410.               /* be able to continue here, we must pass everything that has to
  411.                  to with the strings in this expression */
  412.             } else if (!(pident->flags&FPL_READONLY && !(control&CON_DECLARE)) &&
  413.                      (*scr->text==CHAR_ASSIGN || *scr->text==CHAR_PLUS &&
  414.                       scr->text[1]==CHAR_ASSIGN)) {
  415.               char array=FALSE;
  416.               char multi=FALSE;
  417.               struct fplStr **string; /* current string */
  418.               char app=(*scr->text==CHAR_PLUS);
  419.  
  420.               if(scr->compiling) {
  421.                 if(app)
  422.                   COMPILE(COMP_CMPPLUS);
  423.                 else
  424.                   COMPILE(COMP_ASSIGN);
  425.               }
  426.  
  427.               scr->text+=1+app;
  428.               expr->flags|=FPL_ACTION;
  429.               if(pident->data.variable.num) { /* if array member assign */
  430.                 Eat(scr);
  431.                 if(*scr->text==CHAR_OPEN_BRACE) {
  432.                   /* array assign */
  433.                   multi=TRUE;
  434.                   scr->text++;
  435.                   CALL(Eat(scr));
  436.                 }
  437.                 array=TRUE;
  438.               }
  439.               
  440.               if(!multi) {
  441.                 /* single (array) variable assign */
  442.                 if(array) {
  443.                   pos=ArrayNum(num, pident->data.variable.num,
  444.                                dims, pident->data.variable.dims);
  445.                   if(pos<0) {
  446.                     CALL(Warn(scr, FPLERR_ILLEGAL_ARRAY));
  447.                     pos=0; /* we don't know what was meant! */
  448.                   }
  449.                 } else
  450.                   pos=0;
  451.                 string=&pident->data.variable.var.str[pos];
  452.                 CALL(Expression(val, scr, CON_STRING, NULL));
  453.                 if(!(val->flags&FPL_STRING)) {
  454.                   CALL(Warn(scr, FPLERR_ILLEGAL_ASSIGN));
  455.                 }
  456.                 CALL(StrAssign(val->val.str, scr, string, app));
  457.                 if(app && !(val->flags&FPL_NOFREE))
  458.                   /* Only do this if appending! */
  459.                   FREE(val->val.str);
  460. #ifdef STRING_STACK
  461.                 if(app)
  462.                   /* the string couldn't be freed, but we let them know that
  463.                      we don't use it anymore! */
  464.                   val->val.str->flags=FPLSTR_UNUSED;
  465. #endif
  466.               } else {
  467.                 /* multi [compound] assign! */
  468.                 
  469.                 /*
  470.                  * Count the preceding open braces to get proper level
  471.                  * to assign in.
  472.                  */
  473.                 while(*scr->text==CHAR_OPEN_BRACE) {
  474.                   num++; /* next dimension */
  475.                   scr->text++; /* pass it! */
  476.                   CALL(Eat(scr));
  477.                 }
  478.                 
  479.                 do {
  480.                   while(1) {
  481.                     hit=TRUE;
  482.                     
  483.                     /* parse the controlling braces and commas */
  484.                     switch(*scr->text) {
  485.                     case CHAR_CLOSE_BRACE:
  486.                       if(scr->compiling)
  487.                         COMPILE(COMP_END_OF_BLOCK);
  488.                       num--; /* back one dimension */
  489.                       if(num>=0 && num<pident->data.variable.num)
  490.                         dims[num]=0;
  491.                       else {
  492.                         CALL(Warn(scr,FPLERR_ILLEGAL_ARRAY));
  493.                         num=0; /* force counter to zero! */
  494.                       }
  495.                       scr->text++;
  496.                       break;
  497.                     case CHAR_COMMA:
  498.                       /*
  499.                        * Increase the last dimension member for next loop:
  500.                        */
  501.                       if(scr->compiling)
  502.                         COMPILE(COMP_COMMA);
  503.                       if(num>0 && num<=pident->data.variable.num)
  504.                         dims[num-1]++;
  505.                       else {
  506.                         CALL(Warn(scr, FPLERR_ILLEGAL_ARRAY));
  507.                         /* force counter back to top position! */
  508.                         num=pident->data.variable.num;
  509.                       } scr->text++;
  510.                       break;
  511.                     case CHAR_OPEN_BRACE:
  512.                       if(scr->compiling)
  513.                         COMPILE(COMP_START_OF_BLOCK);
  514.                       num++; /* next dimension */
  515.                       scr->text++;
  516.                       break;
  517.                     default:
  518.                       hit=FALSE;
  519.                       break;
  520.                     }
  521.                     if(hit && !ret) {
  522.                       CALL(Eat(scr));
  523.                     } else
  524.                       break;
  525.                   }
  526.                   
  527.                   
  528.                   if(!num)
  529.                     break;
  530.                   
  531.                   pos=ArrayNum(num, pident->data.variable.num,
  532.                                dims, pident->data.variable.dims);
  533.                   if(pos<0) {
  534.                     CALL(Warn(scr, FPLERR_ILLEGAL_ARRAY));
  535.                     pos=0; /* force back to sane number */
  536.                   }
  537.                   
  538.                   /* assign! */
  539.                   
  540.                   string=&pident->data.variable.var.str[pos];
  541.                   
  542.                   CALL(Expression(val, scr, CON_STRING, NULL));
  543.                   if(!(val->flags&FPL_STRING)) {
  544.                     CALL(Warn(scr, FPLERR_ILLEGAL_ASSIGN));
  545.                   }
  546.                   CALL(StrAssign(val->val.str, scr, string, app));
  547.                   if(app && !(val->flags&FPL_NOFREE))
  548.                     /* only if we're appending! */
  549.                     FREE(val->val.str);
  550. #ifdef STRING_STACK
  551.                   if(app)
  552.                     /* the string couldn't be freed, but we let them know that
  553.                        we don't use it anymore! */
  554.                     val->val.str->flags=FPLSTR_UNUSED;
  555. #endif
  556.                   /* while  */
  557.                 } while(1);
  558.               }
  559.               expr->val.str=*string;
  560.               expr->flags|=FPL_STRING|FPL_NOFREE;
  561.             } else {
  562.               if(control&CON_DECLARE)
  563.                 expr->val.val=0;
  564.               else if(pident->data.variable.num) {
  565.                 pos=ArrayNum(num, pident->data.variable.num,
  566.                              dims, pident->data.variable.dims);
  567.                 if(pos<0) {
  568.                   CALL(Warn(scr, FPLERR_ILLEGAL_ARRAY));
  569.                   pos=0; /* force back to sane number */
  570.                 }
  571.                 expr->val.str=pident->data.variable.var.str[pos];
  572.               } else
  573.                 expr->val.str=pident->data.variable.var.str[0];
  574.               expr->flags|=FPL_STRING|FPL_NOFREE;
  575.             }
  576.           } else {        /* integer variable... */
  577.             if(control&CON_STRING) {
  578.               /* NO integers allowed! */
  579.               CALL(Warn(scr, FPLERR_ILLEGAL_STATEMENT));
  580.             }
  581.             if(pident->flags&FPL_READONLY && !(control&CON_DECLARE)) {
  582.               if(!pident->data.variable.num)
  583.                 expr->val.val=pident->data.variable.var.val32[0];
  584.               else {
  585.                 pos=ArrayNum(num, pident->data.variable.num,
  586.                              dims, pident->data.variable.dims);
  587.                 if(pos<0) {
  588.                   CALL(Warn(scr, FPLERR_ILLEGAL_ARRAY));
  589.                   pos=0; /* force back to sane number */
  590.                 }
  591.                 
  592.                 expr->val.val=pident->data.variable.var.val32[pos];
  593.               }
  594.             } else if(!expr->operator && !expr->unary &&
  595.                       ASSIGN_OPERATOR) {
  596.               
  597.               /* integer assign */
  598.               
  599.               char array=FALSE;    /* is it an array variable */
  600.               char multi=FALSE;    /* mutiple variable */
  601.               char was=*scr->text;
  602.               expr->flags|=FPL_ACTION;
  603.               if(*scr->text==CHAR_ASSIGN)
  604.                 scr->text++;
  605.               else if(scr->text[2]==CHAR_ASSIGN)
  606.                 scr->text+=3;
  607.               else
  608.                 scr->text+=2;
  609.               if(pident->data.variable.num) { /* if array member assign */
  610.                 Eat(scr);
  611.                 if(*scr->text==CHAR_OPEN_BRACE) {
  612.                   if(scr->compiling)
  613.                     COMPILE(COMP_START_OF_BLOCK);
  614.                   /* array assign */
  615.                   multi=TRUE;
  616.                   scr->text++;
  617.                   CALL(Eat(scr));
  618.                 }
  619.                 array=TRUE;
  620.               }
  621.               
  622.               if(!multi) {
  623.                 if(!array)
  624.                   pos=0;
  625.                 else {
  626.                   /* single (array) variable assign */
  627.                   pos=ArrayNum(num, pident->data.variable.num,
  628.                                dims, pident->data.variable.dims);
  629.                   if(pos<0) {
  630.                     CALL(Warn(scr, FPLERR_ILLEGAL_ARRAY));
  631.                     pos=0; /* force back to a decent number */
  632.                   }
  633.                 }
  634.                 if(scr->compiling)
  635.                   COMPILE(COMP_START_OF_EXPR);
  636.                 CALL(Expression(val, scr, CON_NORMAL|CON_NUM, NULL));
  637.                 if(scr->compiling)
  638.                   COMPILE(COMP_END_OF_EXPR);
  639.                 CALL(CmpAssign(scr, val->val.val,
  640.                                &pident->data.variable.var.val32[pos],
  641.                                pident->flags, was));
  642.                 expr->val.val=pident->data.variable.var.val32[pos];
  643.               } else {
  644.                 /* multi [compound] assign */
  645.                 
  646.                 /*
  647.                  * Count the preceding open braces to get proper level
  648.                  * to assign in.
  649.                  */
  650.                 while(*scr->text==CHAR_OPEN_BRACE) {
  651.                   num++; /* next dimension */
  652.                   scr->text++; /* pass it! */
  653.                   CALL(Eat(scr));
  654.                 }
  655.                 
  656.                 do {
  657.                   while(1) {
  658.                     char hit=TRUE;
  659.                     
  660.                     /* parse the controlling braces and commas */
  661.                     switch(*scr->text) {
  662.                     case CHAR_CLOSE_BRACE:
  663.                       if(scr->compiling)
  664.                         COMPILE(COMP_END_OF_BLOCK);
  665.                       num--; /* back one dimension */
  666.                       if(num>=0 && num<pident->data.variable.num)
  667.                         dims[num]=0;
  668.                       else {
  669.                         CALL(Warn(scr, FPLERR_ILLEGAL_ARRAY));
  670.                         num=0;
  671.                       }
  672.                       scr->text++;
  673.                       break;
  674.                     case CHAR_COMMA:
  675.                       /*
  676.                        * Increase the last dimension member for next loop:
  677.                        */
  678.                       if(scr->compiling)
  679.                         COMPILE(COMP_COMMA);
  680.                       if(num>0 && num<=pident->data.variable.num)
  681.                         dims[num-1]++;
  682.                       else {
  683.                         CALL(Warn(scr, FPLERR_ILLEGAL_ARRAY));
  684.                         num=pident->data.variable.num;
  685.                       }
  686.                       scr->text++;
  687.                       break;
  688.                     case CHAR_OPEN_BRACE:
  689.                       if(scr->compiling)
  690.                         COMPILE(COMP_START_OF_BLOCK);
  691.                       num++; /* next dimension */
  692.                       scr->text++;
  693.                       break;
  694.                     default:
  695.                       hit=FALSE;
  696.                       break;
  697.                     }
  698.                     if(hit && !ret) {
  699.                       CALL(Eat(scr));
  700.                     } else
  701.                       break;
  702.                   }
  703.                   
  704.                   if(!num)
  705.                     break;
  706.                   
  707.                   pos=ArrayNum(num, pident->data.variable.num,
  708.                                dims, pident->data.variable.dims);
  709.                   if(pos<0) {
  710.                     CALL(Warn(scr, FPLERR_ILLEGAL_ARRAY));
  711.                     pos=0;
  712.                   }
  713.                   
  714.                   /* assign! */
  715.                   if(scr->compiling)
  716.                     COMPILE(COMP_START_OF_EXPR);
  717.                   CALL(Expression(val, scr, CON_NORMAL|CON_NUM, NULL));
  718.                   if(scr->compiling)
  719.                     COMPILE(COMP_END_OF_EXPR);
  720.                   CALL(CmpAssign(scr, val->val.val, &pident->data.variable.var.val32[pos],
  721.                                  pident->flags, was));
  722.                   expr->val.val=pident->data.variable.var.val32[pos];
  723.                   
  724.                   /* while  */
  725.                 } while(1);
  726.               }
  727.               expr->flags|=FPL_NOFREE; /* the memory pointed to by the expr->val.val
  728.                                           is strings of proper variables. Do
  729.                                           not free them now! */
  730.             } else {
  731.               /*
  732.                * No assignment, primary operator or none at all!
  733.                */
  734.               long *value;
  735.               if(control&CON_DECLARE)
  736.                 expr->val.val=0;
  737.               else {
  738.                 if(pident->data.variable.num) {
  739.                   pos=ArrayNum(num, pident->data.variable.num,
  740.                                dims, pident->data.variable.dims);
  741.                   if(pos<0) {
  742.                     CALL(Warn(scr, FPLERR_ILLEGAL_ARRAY));
  743.                     pos=0;
  744.                   }
  745.                 } else
  746.                   pos=0;
  747.                 value=&pident->data.variable.var.val32[pos];
  748.               
  749.                 if(*point==CHAR_PLUS && point[1]==CHAR_PLUS) {
  750.                   /*post increment*/
  751.                   if(scr->compiling)
  752.                     COMPILE(COMP_POSTINC);
  753.                   expr->flags|=FPL_ACTION;
  754.                   expr->val.val=(*value)++;
  755.                   scr->text+=2;
  756.                 } else if(*point==CHAR_MINUS && point[1]==CHAR_MINUS) {
  757.                   /* post decrement */
  758.                   if(scr->compiling)
  759.                     COMPILE(COMP_POSTDEC);
  760.                   expr->flags|=FPL_ACTION;
  761.                   expr->val.val=(*value)--;
  762.                   scr->text+=2;
  763.                 } else {
  764.                   /* plain variable or pre operation */
  765.                   if(un=expr->unary) {
  766.                     if(un->unary!=OP_PREINC && un->unary!=OP_PREDEC) {
  767.                       expr->val.val=*value;
  768.                     } else {
  769.                       if(un->unary==OP_PREINC)
  770.                         expr->val.val=++(*value);
  771.                       else
  772.                         expr->val.val=--(*value);
  773.                       expr->unary=un->next;
  774.                       FREE(un);
  775.                     }
  776.                   } else
  777.                     expr->val.val=*value;
  778.                 }
  779.                 if(pident->flags&FPL_VARIABLE_LESS32) {
  780.                   if(pident->flags&FPL_CHAR_VARIABLE) {
  781.                     expr->val.val=(long)((signed char)expr->val.val);
  782.                     *value=(long)((signed char)*value);
  783.                   } else {
  784.                     /* sixteen bits */
  785.                     expr->val.val=(long)((signed short)expr->val.val);
  786.                     *value=(long)((signed short)*value);                  
  787.                   }
  788.                 }
  789.               }
  790.               CALL(NewMember(scr, &expr));
  791.             }
  792.           }   /* end of integer handling */
  793.         } else if(ret && (*scr->text!=CHAR_OPEN_PAREN))
  794.           return(ret); /* FPLERR_IDENTIFIER_NOT_FOUND */
  795.         else {                     /* some sort of function */
  796.           /*
  797.            * FUNCTION HANDLER PART:
  798.            */
  799.  
  800.           struct fplArgument *pass; /* struct pointer to send as argument to
  801.                                        the function handler */
  802.           char allocspace;
  803.           
  804.           if(ret) {
  805.             if(!(scr->flags&FPLDATA_ALLFUNCTIONS) ||
  806.                *scr->text!=CHAR_OPEN_PAREN)
  807.               /* If the ability to parse all functions isn't turned on, or if
  808.                  the following character is not an open parenthesis, fail! */
  809.               return(ret);
  810.           }
  811.           
  812.           num=0;    /* number of arguments */
  813.  
  814.           expr->flags|=FPL_OPERAND|FPL_ACTION; /* This sure is action...! */
  815.           
  816.           GETMEM(pass, sizeof(struct fplArgument));
  817.  
  818.           if(!ident) {
  819.             /* The function does not exist as a declared function! */
  820.             STRDUP(pass->name, scr->buf);
  821.             pass->ID=FPL_UNKNOWN_FUNCTION;
  822.             text="o>"; /* optional parameter list as argument! */
  823.           } else {
  824.             pass->name=ident->name;
  825.             pass->ID=ident->data.external.ID;
  826.             text=ident->data.inside.format;
  827.           }
  828.           pass->argc=0;
  829.           pass->key=(void *)scr;
  830.           if(*scr->text!=CHAR_OPEN_PAREN) {
  831.             CALL(Warn(scr, FPLERR_MISSING_PARENTHESES));  /* >warning< */
  832.           } else
  833.             scr->text++;
  834.           if(scr->compiling)
  835.             COMPILE(COMP_START_OF_PARAMETERS);
  836.           CALL(Eat(scr));
  837.           
  838.           if(text && *text) {
  839.             unsigned char a=0;
  840.  
  841.             /* if the function takes arguments */
  842.             
  843.             if(*text==FPL_ARGLIST) /* can't start with paramter list */
  844.               text="o>"; /* use optional parameter list as default then! */
  845.             /*
  846.              * Allocate arrays to use for data storage while parsing
  847.              * the arguments. Maximum number of arguments is
  848.              * MAX_ARGUMENTS.
  849.              */
  850.               
  851.             num=strlen(text);   /* number of arguments to this function */
  852.               
  853.             if(text[num-1]!=FPL_ARGLIST)
  854.               allocspace=num+1;
  855.             else
  856.               allocspace=MAX_ARGUMENTS;
  857.               
  858.             /*
  859.              * By adjusting the number of allocated bytes to the smallest
  860.              * necessary, my recursive example program used only a fifth
  861.              * as much memory as when always allocating memory for
  862.              * MAX_ARGUMENTS.
  863.              */
  864.               
  865.             /* allocate an array */
  866.             GETMEM(pass->argv, sizeof(char *)*allocspace);
  867.               
  868.             /* allocate new format string */
  869.             GETMEM(pass->format, sizeof(char)*allocspace);
  870.  
  871.             /* allocate allocate-flag string */
  872.             GETMEM(array, sizeof(char)*allocspace);
  873.             
  874.             while(!ret && *scr->text!=CHAR_CLOSE_PAREN && text && *text) {
  875.               a=(*text==FPL_ARGLIST)?a:UPPER(*text);
  876.               switch(a) {
  877.               case FPL_OPTARG:
  878.               case FPL_STRARG:
  879.                 CALL(Expression(val, scr, (a==FPL_STRARG?CON_STRING:0), NULL));
  880.                 if(a==FPL_STRARG && !(val->flags&FPL_STRING)) {
  881.                   CALL(Warn(scr, FPLERR_ILLEGAL_PARAMETER));
  882.                 }
  883.                 
  884.                 if(a==FPL_STRARG || val->flags&FPL_STRING) {
  885.  
  886.                   /* Enter string symbol in the created format string! */
  887.                   pass->format[pass->argc]=FPL_STRARG;
  888.  
  889.                   if(val->val.str) {
  890.                     /* Set this to TRUE if deallocation is wanted on this
  891.                        string after the function call! */
  892.                     array[pass->argc]=!(val->flags&FPL_NOFREE);
  893.                     /*
  894.                      * Point to the string (that is zero terminated)!
  895.                      */
  896.                     pass->argv[pass->argc]=val->val.str->string;
  897.                   } else {
  898.                     GETMEM(string, sizeof(struct fplStr));
  899.             memset(string, 0, sizeof(struct fplStr));
  900.             pass->argv[pass->argc]=string->string;
  901.                     array[pass->argc]=1; /* allocation has been done! */
  902.                   }
  903.                 } else {
  904.                   pass->format[pass->argc]=FPL_INTARG;
  905.                   pass->argv[pass->argc]=(void *)val->val.val;
  906.                 }
  907.                 pass->argc++;
  908.                 break;
  909.               case FPL_INTARG:
  910.                 CALL(Expression(val, scr, CON_NUM, NULL));
  911.                 pass->format[pass->argc]=FPL_INTARG;
  912.                 pass->argv[pass->argc++]=(void *)val->val.val;
  913.                 break;
  914.               case FPL_STRVARARG:
  915.               case FPL_INTVARARG:
  916.                 CALL(Getword(scr->buf, scr));
  917.                 /* Use the `pident' pointer here, cause the `ident' pointer
  918.                    is already being used by the function we're about to
  919.                    invoke! */
  920.                 CALL(GetIdentifier(scr, scr->buf, &pident));
  921.                 if(scr->compiling)
  922.                   COMPILESYMBOL(scr->buf);
  923.                 if(pident->flags&FPL_INT_VARIABLE && a==FPL_STRVARARG ||
  924.                    pident->flags&FPL_STRING_VARIABLE && a==FPL_INTVARARG) {
  925.                   CALL(Warn(scr, FPLERR_ILLEGAL_VARIABLE));
  926.                   pass->argv[pass->argc]=NULL; /* can't copy wrong variable! */
  927.                 } else 
  928.                   pass->argv[pass->argc]=(void *)pident;
  929.  
  930.                 pass->format[pass->argc++]=(a==FPL_STRVARARG?a:FPL_INTVARARG);
  931.                 Eat(scr);
  932.                 break;
  933.               default:
  934.                 CALL(Warn(scr, FPLERR_ILLEGAL_PARAMETER));
  935.                 break; /* just ignore it and be happy! */
  936.               }
  937.               if(*text!=FPL_ARGLIST)
  938.                 text++;
  939.               if(*scr->text==CHAR_COMMA) {
  940.                 scr->text++;
  941.                 if(scr->compiling)
  942.                   COMPILE(COMP_COMMA);
  943.               }
  944.             }
  945.             pass->format[pass->argc]=CHAR_ASCII_ZERO;
  946.             if(text && *text && !(*text&CASE_BIT)) {
  947.               return(FPLERR_MISSING_ARGUMENT);
  948.               /*
  949.                * This is a serious mis-use. The function is called with to few
  950.                * parameters. At least one parameter missing is a required one.
  951.                * I really can't figure out a way to survive such a shock!
  952.                */
  953.             }
  954.           } else
  955.             pass->format=NULL;
  956.           if(*scr->text!=CHAR_CLOSE_PAREN) {
  957.             CALL(Warn(scr, FPLERR_ILLEGAL_PARAMETER)); /* too many parameters! */
  958.             /* It's ok to continue without the parenthesis! */
  959.           } else 
  960.             scr->text++;
  961.  
  962.           if(scr->compiling)
  963.             COMPILE(COMP_END_OF_PARAMETERS);
  964.           if(!ident || FPL_OPTARG == ident->data.inside.ret) {
  965.             /*
  966.              * The function we invoked was not found regularly!
  967.          * Set return type!
  968.          */
  969.  
  970.         /*
  971.              * We try to determine whether it should return an int or a string.
  972.              * We interpret the return value as we should do to make it pass
  973.              * as a valid expression. That is, if the flag tells us this
  974.              * should be a string expression to be valid, we take it as a
  975.              * string, but if it tells us its an integer expression, we read
  976.              * it as an integer!!!
  977.              */
  978.  
  979.             if(control&CON_STRING)
  980.               hit = FPL_STRARG;
  981.             else {
  982.               if(control&CON_NUM)
  983.                 hit = FPL_INTARG;
  984.               else
  985.                 /*
  986.                  * We don't know which kind of return code the function
  987.                  * should give us!
  988.                  */
  989.                 hit = FPL_OPTARG;
  990.             }
  991.  
  992.       } else
  993.             hit=UPPER(ident->data.inside.ret);
  994.  
  995.           pass->ret = hit; /* set return type member of pass struct */
  996.  
  997.           /*
  998.            * Call the function if not compiling!
  999.            */
  1000.           if(!scr->compiling)
  1001.             CALL(CallFunction(scr, pass, ident));
  1002.  
  1003.           if(!ident) {
  1004.             /*
  1005.              * The function we invoked was not found regularly!
  1006.          * Free the name we allocated temporarily and set
  1007.          * return type to optional!
  1008.          */
  1009.             FREE(pass->name); /* the name was strdup()'ed! */
  1010.       }
  1011.           
  1012.           if(FPL_OPTARG == hit) {
  1013.  
  1014.             CALL(GetMessage(scr, FPLMSG_RETURN_INT, &msg));
  1015.             if(!msg) {
  1016.               /* There is no 'int' return. Check if there is any 'string'
  1017.                  return, otherwise say it is an 'int' anyway! */
  1018.               CALL(GetMessage(scr, FPLMSG_RETURN_STRING, &msg));
  1019.               if(!msg)
  1020.                 /* no string either, default to int! */
  1021.                 hit = FPL_INTARG;
  1022.               else
  1023.                 /* found string, it returned a 'string' !!! */
  1024.                 hit = FPL_STRARG;
  1025.             } else {
  1026.               /* There is a return 'int' message! This may well be a
  1027.                  function returning int! */
  1028.               hit = FPL_INTARG;
  1029.             }
  1030.  
  1031.           }
  1032.  
  1033.           if(hit==FPL_STRARG)
  1034.             /* if the return value should be a string: */
  1035.             HandleString(scr, expr);
  1036.           else {
  1037.             /* only if integer! or the function is non-existent */
  1038.             CALL(GetMessage(scr, FPLMSG_RETURN_INT, &msg));
  1039.             expr->val.val=(msg?(long)msg->message[0]:0);
  1040.             CALL(NewMember(scr, &expr));
  1041.             if(msg)
  1042.               CALL(DeleteMessage(scr, msg));
  1043.           }
  1044.           while(pass->argc--) {
  1045.             if(pass->format[pass->argc]==FPL_STRARG && array[pass->argc]) {
  1046.               /* free the string if it's been marked to be freed!! */
  1047.               FREE((char *)pass->argv[pass->argc]-
  1048.                    offsetof(struct fplStr, string));
  1049.             }
  1050.           }
  1051.           if(pass->format) {
  1052.             FREE(pass->argv);
  1053.             FREE(pass->format);
  1054.             FREE(array);
  1055.           }
  1056.           FREE(pass);
  1057.         }
  1058.       } else {
  1059.  
  1060.           pos=0;
  1061.           switch(*scr->text) {
  1062.           case CHAR_ZERO:
  1063.             /*
  1064.              * Numbers starting with a '0' can be hex/oct/bin.
  1065.              */
  1066.             if(control&CON_STRING) {
  1067.               /* NO integers allowed! */
  1068.               CALL(Warn(scr, FPLERR_ILLEGAL_STATEMENT));
  1069.             }
  1070.             switch(scr->text[1]) {
  1071.             case CHAR_X:
  1072.               /* hexadecimal number parser */
  1073.               for(scr->text+=2; HEXANUM(*scr->text); scr->text++)
  1074.                 expr->val.val=expr->val.val*16+ (NUMBER(*scr->text)?
  1075.                                          *scr->text-CHAR_ZERO:
  1076.                                          UPPER(*scr->text)-CHAR_UPPER_A+10);
  1077.               if(scr->compiling)
  1078.                 COMPILEINT(expr->val.val);
  1079.               break;
  1080.             case CHAR_B:
  1081.               /* binary number parser */
  1082.               for(scr->text+=2;*scr->text==CHAR_ZERO || *scr->text==CHAR_ONE;)
  1083.                 expr->val.val=expr->val.val*2+ *scr->text++ - CHAR_ZERO;
  1084.               if(scr->compiling)
  1085.                 COMPILEINT(expr->val.val);
  1086.               break;
  1087.             case CHAR_ZERO:
  1088.             case CHAR_ONE:
  1089.             case CHAR_TWO:
  1090.             case CHAR_THREE:
  1091.             case CHAR_FOUR:
  1092.             case CHAR_FIVE:
  1093.             case CHAR_SIX:
  1094.             case CHAR_SEVEN:
  1095.               /* octal number parser */
  1096.               for(scr->text++;*scr->text>=CHAR_ZERO && *scr->text<=CHAR_SEVEN;)
  1097.                 expr->val.val=expr->val.val*8+ *scr->text++ - CHAR_ZERO;
  1098.               if(scr->compiling)
  1099.                 COMPILEINT(expr->val.val);
  1100.               break;
  1101.             default:
  1102.               /* a single zero is simply 0 */
  1103.               scr->text++;
  1104.               expr->val.val=0;
  1105.               if(scr->compiling)
  1106.                 COMPILEINT(0);
  1107.               break;
  1108.             }
  1109.             CALL(NewMember(scr, &expr));
  1110.             break;
  1111.         /* end of case CHAR_ZERO: */
  1112.   
  1113.           case CHAR_ONE:
  1114.           case CHAR_TWO:
  1115.           case CHAR_THREE:
  1116.           case CHAR_FOUR:
  1117.           case CHAR_FIVE:
  1118.           case CHAR_SIX:
  1119.           case CHAR_SEVEN:
  1120.           case CHAR_EIGHT:
  1121.           case CHAR_NINE:
  1122.             /*
  1123.              * We hit a number between 1 and 9.
  1124.              */
  1125.             if(control&CON_STRING) {
  1126.               /* NO integers allowed! */
  1127.               CALL(Warn(scr, FPLERR_ILLEGAL_STATEMENT));
  1128.             }
  1129.             do
  1130.               expr->val.val= expr->val.val*10 + *scr->text++ - CHAR_ZERO;
  1131.             while(NUMBER(*scr->text));
  1132.             if(scr->compiling)
  1133.               COMPILEINT(expr->val.val);
  1134.             CALL(NewMember(scr, &expr));
  1135.         break;
  1136.   
  1137.         case CHAR_QUOTATION_MARK:
  1138.             if(control&CON_NUM) {
  1139.               /* NO integers allowed! */
  1140.               CALL(Warn(scr, FPLERR_ILLEGAL_STATEMENT));
  1141.             }
  1142.             CALL(Convert(val, scr));
  1143.             /* This returned a string! */
  1144.             expr->val.str=val->val.str;
  1145.             expr->flags=FPL_STRING;
  1146.             if(scr->compiling)
  1147.               COMPILESTRING(expr->val.str->string);
  1148.  
  1149.         break;
  1150.   
  1151.         case CHAR_APOSTROPHE:
  1152.             /*
  1153.              * Apostrophes surround character. Returns ASCII code.
  1154.              */
  1155.             if(control&CON_STRING) {
  1156.               /* NO integers allowed! */
  1157.               CALL(Warn(scr, FPLERR_ILLEGAL_STATEMENT));
  1158.             }
  1159.             CALL(ReturnChar((scr->text++, scr), &expr->val.val, FALSE));
  1160.             if(*scr->text!=CHAR_APOSTROPHE) {
  1161.               CALL(Warn(scr, FPLERR_MISSING_APOSTROPHE)); /* >warning< */
  1162.               /* just continue as nothing has ever happened! */
  1163.             } else
  1164.               scr->text++;
  1165.             if(scr->compiling)
  1166.               COMPILEINT(expr->val.val);
  1167.             CALL(NewMember(scr, &expr));
  1168.         break;
  1169.   
  1170.         case CHAR_OPEN_PAREN:
  1171.             if(scr->compiling)
  1172.               COMPILE(COMP_START_OF_EXPR);
  1173.             CALL(Expression(val, (++scr->text, scr), CON_GROUNDLVL|CON_NUM, NULL));
  1174.             if(*scr->text!=CHAR_CLOSE_PAREN) {
  1175.               CALL(Warn(scr, FPLERR_MISSING_PARENTHESES)); /* >warning< */
  1176.               /* Go on anyway! */
  1177.             } else
  1178.               scr->text++;
  1179.             if(scr->compiling)
  1180.               COMPILE(COMP_END_OF_EXPR);
  1181.             expr->val.val=val->val.val;
  1182.             CALL(NewMember(scr, &expr));
  1183.             break;
  1184.   
  1185.         case CHAR_NOT_OPERATOR:
  1186.             CALL(AddUnary(scr, expr, OP_NOT));
  1187.             ++scr->text;
  1188.             if(scr->compiling)
  1189.               COMPILE(COMP_NOT);
  1190.             break;
  1191.   
  1192.         case CHAR_ONCE_COMPLEMENT:
  1193.             CALL(AddUnary(scr, expr, OP_COMPL));
  1194.             ++scr->text;
  1195.             if(scr->compiling)
  1196.               COMPILE(COMP_1COMPL);
  1197.           break;
  1198.   
  1199.         case CHAR_PLUS:
  1200.             if(scr->text[1]==CHAR_PLUS) {
  1201.               expr->flags|=FPL_ACTION;
  1202.               scr->text+=2;
  1203.               CALL(AddUnary(scr, expr, OP_PREINC));
  1204.               if(scr->compiling)
  1205.                 COMPILE(COMP_PREINC);
  1206.             } else {
  1207.               CALL(AddUnary(scr, expr, OP_PLUS));
  1208.               scr->text++;
  1209.               if(scr->compiling)
  1210.                 COMPILE(COMP_PLUS);
  1211.             }
  1212.             break;
  1213.   
  1214.         case CHAR_MINUS:
  1215.             if(scr->text[1]==CHAR_MINUS) {
  1216.               expr->flags|=FPL_ACTION;
  1217.               scr->text+=2;
  1218.               CALL(AddUnary(scr, expr, OP_PREDEC));
  1219.               if(scr->compiling)
  1220.                 COMPILE(COMP_PREDEC);
  1221.             } else {
  1222.               CALL(AddUnary(scr, expr, OP_MINUS));
  1223.               scr->text++;
  1224.               if(scr->compiling)
  1225.                 COMPILE(COMP_MINUS);
  1226.             }
  1227.             break;
  1228.   
  1229.           default:
  1230.   
  1231.             if((*scr->text==CHAR_SEMICOLON && control&CON_SEMICOLON) ||
  1232.                (*scr->text==CHAR_CLOSE_PAREN && control&CON_PAREN) 
  1233.                && basexpr==expr && expr->operator==OP_NOTHING) {
  1234.               /* for(;;) support.
  1235.                  There must not have been a previous operand or operator */
  1236.               pos=expr->val.val=TRUE;
  1237.               if(scr->compiling)
  1238.                 COMPILE(COMP_END_OF_EXPR);
  1239.             } else {   /* no operand results in error! */
  1240.               CALL(Warn(scr, FPLERR_MISSING_OPERAND)); /* WARNING! */
  1241.               expr->operator=OP_NOTHING; /* reset */
  1242.             }
  1243.           break;
  1244.         }
  1245.         if(pos)
  1246.           break;
  1247.       }
  1248.  
  1249.     } else {                                         /* waiting for operator */
  1250.       char *point=scr->text;
  1251.       switch(*scr->text) {
  1252.       case CHAR_ASSIGN:
  1253.         if(scr->text[1]==CHAR_ASSIGN) {
  1254.           expr->operator=OP_EQUAL;
  1255.           scr->text+=2;
  1256.           if(scr->compiling)
  1257.             COMPILE(COMP_EQUAL);
  1258.         }
  1259.         break;
  1260.       case CHAR_AND:
  1261.     if(scr->text[1]==CHAR_AND) {
  1262.           expr->operator=OP_LOGAND;
  1263.           scr->text+=2;
  1264.           if(scr->compiling)
  1265.             COMPILE(COMP_LOGAND);
  1266.         } else {
  1267.           expr->operator=OP_BINAND;
  1268.           scr->text++;
  1269.           if(scr->compiling)
  1270.             COMPILE(COMP_BINAND);
  1271.         }
  1272.         break;
  1273.       case CHAR_OR:
  1274.         if(scr->text[1]==CHAR_OR) {
  1275.           expr->operator=OP_LOGOR;
  1276.           scr->text+=2;
  1277.           if(scr->compiling)
  1278.             COMPILE(COMP_LOGOR);
  1279.         } else {
  1280.           expr->operator=OP_BINOR;
  1281.           scr->text++;
  1282.           if(scr->compiling)
  1283.             COMPILE(COMP_BINOR);
  1284.         }
  1285.         break;
  1286.       case CHAR_PLUS:
  1287.         expr->operator=OP_PLUS;
  1288.         ++scr->text;
  1289.         if(scr->compiling)
  1290.           COMPILE(COMP_PLUS);
  1291.         break;
  1292.       case CHAR_MINUS:
  1293.         expr->operator=OP_MINUS;
  1294.         ++scr->text;
  1295.         if(scr->compiling)
  1296.           COMPILE(COMP_MINUS);
  1297.         break;
  1298.       case CHAR_QUESTION:
  1299.         expr->operator=OP_COND1;
  1300.         ++scr->text;
  1301.         if(scr->compiling)
  1302.           COMPILE(COMP_COND1);
  1303.         break;
  1304.       case CHAR_COLON:
  1305.         if(conditional&FPLBIT_CONDITIONAL) {
  1306.           /* only if preceeded with the regular '?' operator! */
  1307.           expr->operator=OP_COND2;
  1308.           ++scr->text;
  1309.           if(scr->compiling)
  1310.             COMPILE(COMP_COND2);
  1311.         }
  1312.         break;
  1313.       case CHAR_MULTIPLY:
  1314.         expr->operator=OP_MULTIPLY;
  1315.         ++scr->text;
  1316.         if(scr->compiling)
  1317.           COMPILE(COMP_MULTIPLY);
  1318.         break;
  1319.       case CHAR_DIVIDE:
  1320.         expr->operator=OP_DIVISION;
  1321.         ++scr->text;
  1322.         if(scr->compiling)
  1323.           COMPILE(COMP_MULTIPLY);
  1324.         break;
  1325.       case CHAR_REMAIN:
  1326.         expr->operator=OP_REMAIN;
  1327.         ++scr->text;
  1328.         if(scr->compiling)
  1329.           COMPILE(COMP_REMAIN);
  1330.         break;
  1331.       case CHAR_XOR:
  1332.         expr->operator=OP_BINXOR;
  1333.         ++scr->text;
  1334.         if(scr->compiling)
  1335.           COMPILE(COMP_BINXOR);
  1336.         break;
  1337.       case CHAR_LESS_THAN:
  1338.         if(scr->text[1]==CHAR_ASSIGN) {
  1339.           scr->text+=2;
  1340.           expr->operator=OP_LESSEQ;
  1341.           if(scr->compiling)
  1342.             COMPILE(COMP_LESSEQ);
  1343.         } else if(scr->text[1]==CHAR_LESS_THAN) {
  1344.           scr->text+=2;
  1345.           expr->operator=OP_SHIFTL;
  1346.           if(scr->compiling)
  1347.             COMPILE(COMP_SHIFTL);
  1348.         } else {
  1349.           scr->text++;
  1350.           expr->operator=OP_LESS;
  1351.           if(scr->compiling)
  1352.             COMPILE(COMP_LESS);
  1353.         }
  1354.         break;
  1355.       case CHAR_GREATER_THAN:
  1356.     if(scr->text[1]==CHAR_ASSIGN) {
  1357.           expr->operator= OP_GRETEQ;
  1358.           scr->text+=2;
  1359.           if(scr->compiling)
  1360.             COMPILE(COMP_GRETEQ);
  1361.         } else if(scr->text[1]==CHAR_GREATER_THAN) {
  1362.           scr->text+=2;
  1363.           expr->operator=OP_SHIFTR;
  1364.           if(scr->compiling)
  1365.             COMPILE(COMP_SHIFTR);
  1366.         } else {
  1367.           scr->text++;
  1368.           expr->operator=OP_GRET;
  1369.           if(scr->compiling)
  1370.             COMPILE(COMP_GRET);
  1371.         }
  1372.         break;
  1373.       case CHAR_NOT_OPERATOR:
  1374.         if(scr->text[1]==CHAR_ASSIGN) {
  1375.           expr->operator=OP_NOTEQ;
  1376.           scr->text+=2;
  1377.           if(scr->compiling)
  1378.             COMPILE(COMP_NOTEQUAL);
  1379.         }
  1380.         break;
  1381.       case CHAR_COMMA:
  1382.         if(control&CON_GROUNDLVL) {
  1383.           Clean(scr, basexpr);
  1384.           GETMEM(basexpr, sizeof(struct Expr));
  1385.           expr=basexpr;
  1386.           expr->val.val=0;
  1387.           expr->unary=NULL;
  1388.           expr->operator=expr->flags=OP_NOTHING;
  1389.           expr->next=NULL;
  1390.           scr->text++;
  1391.           if(scr->compiling)
  1392.             COMPILE(COMP_COMMA);
  1393.         }
  1394.         break;
  1395.       }
  1396.       if(point==scr->text)
  1397.         break;
  1398.       expr->flags&=~FPL_OPERAND; /* clear the operand bit */
  1399.     }
  1400.   }
  1401.   
  1402.   if(!(control&CON_DECLARE)) {
  1403.     /* Get result of the current expression */
  1404.     CALL(Calc(scr, val, basexpr));
  1405.     
  1406.     /*
  1407.      * If this was a stand alone statement, including no action returns an
  1408.      * error!
  1409.      */
  1410.     if(control&CON_ACTION && !(val->flags&FPL_ACTION)) {
  1411.       CALL(Warn(scr, FPLERR_NO_ACTION));
  1412.       /* but we can just as good keep on anyway! */
  1413.     }
  1414.   }
  1415.   
  1416.   Clean(scr, basexpr);    /* erase the rest of the list */
  1417.   if(dims)
  1418.     FREE(dims);
  1419.   return(FPL_OK);
  1420. }
  1421.  
  1422. /**********************************************************************
  1423.  *
  1424.  * ReturnCode Calc();
  1425.  *
  1426.  * Returns the result in the first Expr struct of the expression that
  1427.  * the second parameter holds. This function does not free the expression
  1428.  * list.
  1429.  *
  1430.  *******/
  1431.  
  1432. static ReturnCode INLINE Calc(struct Data *scr, struct Expr *val, struct Expr *basexpr)
  1433. {
  1434.   /* lower value=higher priority. Order as the operator list in script.h:
  1435.    *|    +  -  /  * << >>  %  &  |  ^ && ||  ~    ?   :  == <= >=  <  > != ! */
  1436.   const static unsigned char priority[]={
  1437.     255, 1, 1, 0, 0, 2, 2, 0, 5, 7, 6, 8, 9, 255, 10, 10, 4, 3, 3, 3, 3, 4, 255
  1438.     };
  1439.   
  1440.   ReturnCode ret;
  1441.   unsigned char pri, minpri=255, maxpri=0;
  1442.   struct Expr *expr=basexpr, *last;
  1443.   struct Unary *un, *next;
  1444.   
  1445.   /* first all Unary expressions */
  1446.   if(!(expr->flags&FPL_STRING))
  1447.     while(expr) {
  1448.       if(priority[expr->operator]<minpri)
  1449.         minpri=priority[expr->operator]; /* get the lowest priority */
  1450.       if(priority[expr->operator]>maxpri && expr->operator!=OP_NOTHING)
  1451.         maxpri=priority[expr->operator]; /* get the highest priority */
  1452.       if(expr->flags&FPL_STRING) {
  1453.         CALL(Warn(scr, FPLERR_ILLEGAL_VARIABLE));
  1454.         /*
  1455.          * A string among the integers!
  1456.          * We remove this and try next!
  1457.          */
  1458.  
  1459.         last=expr->next;
  1460.         FREE(expr); /* delete this bastard from the expression!!! */
  1461.         expr=last;
  1462.       } else {
  1463.         un=expr->unary;
  1464.         while(un) {
  1465.           switch(un->unary) {
  1466.           case OP_NOT:
  1467.             expr->val.val=!expr->val.val;
  1468.             break;
  1469.           case OP_COMPL:
  1470.             expr->val.val=~expr->val.val;
  1471.             break;
  1472.           case OP_MINUS:
  1473.             expr->val.val=-expr->val.val;
  1474.             break;
  1475.             /*simply ignored! 
  1476.               case OP_PLUS:
  1477.               break;
  1478.               */
  1479.           case OP_PREDEC:
  1480.           case OP_PREINC:
  1481.             CALL(Warn(scr, FPLERR_ILLEGAL_PREOPERATION));
  1482.             /* just ignore it! */
  1483.           }
  1484.           next=un->next;
  1485.           FREE(un);
  1486.           un=next;
  1487.         }
  1488.       }
  1489.       expr=expr->next;
  1490.     }
  1491.   
  1492.   /*
  1493.    * Calculate all members of the linked list in the proper way and put
  1494.    * the result in "val->val.val" before returning "ret". Check for operators
  1495.    * with priority within `minpri' and `maxpri' which we got in the loop
  1496.    * above.
  1497.    *
  1498.    * Check priority level by priority level and perform the right actions.
  1499.    * When reaching the maxpri, there is only one number left: the result!
  1500.    */
  1501.   
  1502.   for(pri=minpri; pri<=maxpri; pri++) {
  1503.     last=expr=basexpr;
  1504.     while(expr=expr->next) {
  1505.       if(priority[expr->operator]==pri) {
  1506.         last->flags|=expr->flags;
  1507.         switch(expr->operator) {
  1508.         case OP_MULTIPLY:
  1509.           last->val.val*=expr->val.val;
  1510.           break;
  1511.         case OP_DIVISION:
  1512.           if(!expr->val.val) {
  1513.             CALL(Warn(scr, FPLERR_DIVISION_BY_ZERO));
  1514.             /* we give a zero as result! */
  1515.             last->val.val=0;
  1516.           } else
  1517.             last->val.val/=expr->val.val;
  1518.           break;
  1519.         case OP_REMAIN:
  1520.           if(!expr->val.val) {
  1521.             CALL(Warn(scr, FPLERR_DIVISION_BY_ZERO));
  1522.             last->val.val=0;
  1523.           } else
  1524.             last->val.val%=expr->val.val;
  1525.           break;
  1526.         case OP_SHIFTL:
  1527.           last->val.val<<=expr->val.val;
  1528.           break;
  1529.         case OP_SHIFTR:
  1530.           last->val.val>>=expr->val.val;
  1531.           break;
  1532.         case OP_BINAND:
  1533.           last->val.val&=expr->val.val;
  1534.           break;
  1535.         case OP_BINOR:
  1536.           last->val.val|=expr->val.val;
  1537.           break;
  1538.         case OP_BINXOR:
  1539.           last->val.val^=expr->val.val;
  1540.           break;
  1541.         case OP_PLUS:
  1542.           last->val.val+=expr->val.val;
  1543.           break;
  1544.         case OP_MINUS:
  1545.           last->val.val-=expr->val.val;
  1546.           break;
  1547.         case OP_EQUAL:
  1548.           last->val.val=last->val.val==expr->val.val;
  1549.           break;
  1550.         case OP_NOTEQ:
  1551.           last->val.val=last->val.val!=expr->val.val;
  1552.           break;
  1553.         case OP_LESSEQ:
  1554.           last->val.val=last->val.val<=expr->val.val;
  1555.           break;
  1556.         case OP_LESS:
  1557.           last->val.val=last->val.val<expr->val.val;
  1558.           break;
  1559.         case OP_GRETEQ:
  1560.           last->val.val=last->val.val>=expr->val.val;
  1561.           break;
  1562.         case OP_GRET:
  1563.           last->val.val=last->val.val>expr->val.val;
  1564.           break;
  1565.         case OP_LOGOR:
  1566.           last->val.val=last->val.val||expr->val.val;
  1567.           break;
  1568.         case OP_LOGAND:
  1569.           last->val.val=last->val.val&&expr->val.val;
  1570.           break;
  1571.         case OP_COND1:
  1572.           if(expr->next && expr->next->operator==OP_COND2) {
  1573.             last->val.val=last->val.val?expr->val.val:expr->next->val.val;
  1574.           } else {
  1575.             CALL(Warn(scr, FPLERR_ILLEGAL_CONDOP)); /* WARNING! */
  1576.             last->val.val=expr->val.val; /* get the number we have! */
  1577.           }
  1578.           break;
  1579.         }
  1580.         last->next=expr->next;
  1581.         FREE(expr);
  1582.         expr=last;
  1583.       } else
  1584.         last=expr;
  1585.     }
  1586.   }
  1587.   val->val.val=basexpr->val.val; /* get the final value */
  1588.   val->flags=basexpr->flags; /* copy the flags */
  1589.   return(FPL_OK);
  1590. }
  1591.  
  1592. /**********************************************************************
  1593.  *
  1594.  * AddUnary();
  1595.  *
  1596.  * Build a linked list on the unary member of the Expr struct!
  1597.  *
  1598.  ******/
  1599.  
  1600. static ReturnCode
  1601. AddUnary(struct Data *scr,
  1602.          struct Expr *expr,
  1603.          Operator unary)
  1604. {
  1605.   struct Unary *next=expr->unary;
  1606.   
  1607.   GETMEM(expr->unary, sizeof(struct Unary));
  1608.   expr->unary->unary=unary;
  1609.   expr->unary->next=next;
  1610.   
  1611.   return(FPL_OK);
  1612. }
  1613.  
  1614.  
  1615. /**********************************************************************
  1616.  *
  1617.  * Clean()
  1618.  *
  1619.  * Erases every track of the linked TalStruct list...
  1620.  *
  1621.  ******/
  1622.  
  1623. static void INLINE Clean(struct Data *scr, struct Expr *basexpr)
  1624. {
  1625.   struct Expr *last;
  1626.   while(basexpr) {
  1627.     last=basexpr->next;
  1628.     FREE(basexpr);
  1629.     basexpr=last;
  1630.   }
  1631. }
  1632.  
  1633. /**********************************************************************
  1634.  *
  1635.  * HandleString();
  1636.  *
  1637.  * Assigns the proper members in the Expr struct after a respons from
  1638.  * a user specified function.
  1639.  *
  1640.  *****/
  1641.  
  1642. static void INLINE HandleString(struct Data *scr,
  1643.                                 struct Expr *expr)
  1644. {
  1645.   struct fplMsg *msg;
  1646.   GetMessage(scr, FPLMSG_RETURN_STRING, &msg);
  1647.   if(!msg || !msg->message[0])
  1648.     /* We got a zero length string or no string at all! */
  1649.     expr->val.str=NULL; /* no string! */
  1650.   else
  1651.     expr->val.str=(struct fplStr *)msg->message[0]; /* the copied string! */
  1652.  
  1653.   expr->flags=FPL_STRING|FPL_ACTION;
  1654.   if(msg)
  1655.     DeleteMessage(scr, msg);
  1656. }
  1657.  
  1658. /**********************************************************************
  1659.  *
  1660.  * Convert()
  1661.  *
  1662.  * Converts the following "string" in the line to a string which it returns.
  1663.  *
  1664.  *********/
  1665.  
  1666. static ReturnCode INLINE Convert(struct Expr *expr, struct Data *scr)
  1667. {
  1668.   ReturnCode ret=FPL_OK;
  1669.   long a;
  1670.   unsigned long pos=0;  /* start position */
  1671.   
  1672.   struct fplStr *pointer, *pek;
  1673.  
  1674.   expr->flags|=FPL_STRING;
  1675.  
  1676. #ifdef STRING_STACK
  1677.   /*
  1678.      First, check with the static string stack to see if this string
  1679.      has already been parsed and is ready to simply restore.
  1680.      Put this string as most recently restored.
  1681.    */
  1682.  
  1683.   /*
  1684.      StringFromStack() uses the scr->text pointer to determine which string
  1685.      we want to have. It also moves our program pointer to the end of the
  1686.      string if it is there.
  1687.    */
  1688.   if(scr->strings_in_stack_max>0) {
  1689.     CALL(StringFromStack(scr, &pointer));
  1690.     if(pointer) {
  1691.       expr->val.str=pointer;
  1692.       expr->flags|=FPL_NOFREE|FPL_STACKED;
  1693.       return FPL_OK;
  1694.     }
  1695.   }
  1696. #endif
  1697.  
  1698.   GETMEM(pointer, sizeof(struct fplStr) + ADDSTRING_DEFAULT);
  1699.   /* create default string space */
  1700.  
  1701.   pointer->alloc=ADDSTRING_DEFAULT;
  1702.   pointer->len=0;
  1703.  
  1704.   expr->val.str=pointer;
  1705.   
  1706. #ifdef DEBUG
  1707.   CheckMem(scr, pointer);
  1708. #endif
  1709.   do {
  1710.     scr->text++;
  1711.     while(*scr->text!=CHAR_QUOTATION_MARK) {
  1712.       CALL(ReturnChar(scr, &a, TRUE));
  1713.       if(a) {
  1714.         pointer->string[pos]=a;
  1715.         if(++pos>=pointer->alloc) {
  1716.           GETMEM(pek, (pointer->alloc+=ADDSTRING_INC)+sizeof(struct fplStr));
  1717.           memcpy(pek, pointer, pos+sizeof(struct fplStr));
  1718.           FREE(pointer);
  1719.           pointer=pek;
  1720.           expr->val.str=pointer;
  1721.         }
  1722.       }
  1723.     }
  1724.     scr->text++;
  1725.     CALL(Eat(scr));
  1726.   } while(*scr->text==CHAR_QUOTATION_MARK);
  1727.   pointer->string[pos]=0; /* zero terminate */
  1728.   pointer->len=pos;       /* length of string */
  1729.   expr->val.str=pointer;
  1730. #ifdef STRING_STACK
  1731.   /*
  1732.      We push our newly scanned string on the string stack. Very useful if
  1733.      this string is reffered in i.e a loop.
  1734.    */
  1735.   if(scr->strings_in_stack_max>0) {
  1736.     CALL(StringToStack(scr, &pointer));
  1737.     if(pointer)
  1738.       /* no one may free a string in the stack! */
  1739.       expr->flags|=FPL_NOFREE|FPL_STACKED;
  1740.   }
  1741. #endif
  1742.  
  1743.   return(ret);
  1744. }
  1745.  
  1746. #ifdef STRING_STACK
  1747. static ReturnCode INLINE StringToStack(struct Data *scr,
  1748.                                        struct fplStr **string)
  1749. {
  1750.   if(scr->stringstackptr >= scr->strings_in_stack_max) {
  1751.     FREE(scr->stringkeeper[ 0 ]); /* free the previous holder of that position! */
  1752.     scr->stringstackptr = 0;
  1753.   } else
  1754.     scr->strings_in_stack_now++;
  1755.  
  1756.   scr->stringstack[ current_entry ].string = *string;
  1757.   scr->stringstack[ current_entry ].text = scr->text;
  1758.   scr->stringstack[ current_entry ].prg = scr->prg;
  1759.   scr->stringstack[ current_entry ].virprg = scr->virprg;
  1760.   scr->stringstackptr++;
  1761. }
  1762.  
  1763. static ReturnCode INLINE StringFromStack(struct Data *scr,
  1764.                                          struct fplStr **string)
  1765. {
  1766.   const long num = scr->stringstackptr;
  1767.   const long max = scr->strings_in_stack_max;
  1768.   long count;
  1769.   for(count=0; count<scr->strings_in_stack_now; count++) {
  1770.     if(scr->stringprogram[ (num-count) >= 0 ?
  1771.                            num-count :
  1772.                            max-count] == scr->text) {
  1773.       *string = scr->stringstack[ count ].string;
  1774.       scr->text = scr->stringstack[ count ].text;
  1775.       scr->prg = scr->stringstack[ count ].prg;
  1776.       scr->virprg = scr->stringstack[ count ].virprg;
  1777.       return FPL_OK;
  1778.     }
  1779.   }
  1780.   *string=NULL;
  1781.   return FPL_OK;
  1782. }
  1783.  
  1784. #endif
  1785.  
  1786. /**********************************************************************
  1787.  *
  1788.  * GetArrayInfo()
  1789.  *
  1790.  * Read the []'s and store the information. Make sure you're standing on
  1791.  * the open bracket!
  1792.  *
  1793.  * Set the int num points to, to any number if you want to limit the number
  1794.  * of dimension reads.
  1795.  */
  1796.  
  1797. static ReturnCode INLINE GetArrayInfo(struct Data *scr,
  1798.                                       long *dims,  /* long array */
  1799.                                       long *num,   /* number of dims */
  1800.                                       long control)
  1801. {
  1802.   struct Expr val;
  1803.   ReturnCode ret=FPL_OK;
  1804.   long maxnum=*num;
  1805.   *num=0;
  1806.   if(scr->compiling)
  1807.     COMPILE(COMP_START_OF_ARRAYINFO);
  1808.   if(*scr->text==CHAR_OPEN_BRACKET) {
  1809.     do {
  1810.       if(scr->compiling)
  1811.         COMPILE(COMP_START_OF_EXPR);
  1812.       scr->text++; /* pass the open bracket */
  1813.       /* eval the expression: */
  1814.       CALL(Expression(&val, scr, CON_GROUNDLVL|CON_NUM, NULL));
  1815.  
  1816.       if(*scr->text!=CHAR_CLOSE_BRACKET) {
  1817.         /* no close bracket means error */
  1818.         CALL(Warn(scr, FPLERR_MISSING_BRACKET)); /* >warning< */
  1819.         /* go on anyway! */
  1820.       } else
  1821.         scr->text++;
  1822.       if(scr->compiling)
  1823.         COMPILE(COMP_END_OF_EXPR);
  1824.  
  1825.       if(val.val.val<(control&CON_DECLARE?1:0)) {
  1826.         /* illegal result of the expression */
  1827.         CALL(Warn(scr, FPLERR_ILLEGAL_ARRAY));
  1828.         val.val.val=(control&CON_DECLARE?1:0); /* reset to decent number! */
  1829.       }
  1830.  
  1831.       dims[(*num)++]=val.val.val; /* Add another dimension */
  1832.       if(*num==maxnum) {
  1833.         /* we've hit the roof! */
  1834.         break;
  1835.       } else if(*num==MAX_DIMS) {
  1836.         /* if we try to use too many dimensions... */
  1837.         ret=FPLERR_ILLEGAL_ARRAY;
  1838.         break;
  1839.       }
  1840.       /*
  1841.        * Go on as long there are braces and we are declaring OR
  1842.        * as long the `num' variable tells us (you, know: when
  1843.        * you want to read character five in a member of a
  1844.        * three dimensional string array, it could look like
  1845.        * "int a=string[2][3][4][5];" ... :-)
  1846.        */
  1847.     } while(*scr->text==CHAR_OPEN_BRACKET);
  1848.   }
  1849.   if(scr->compiling)
  1850.     COMPILE(COMP_END_OF_ARRAYINFO);
  1851.  
  1852.   return(ret);
  1853. }
  1854.  
  1855. /**********************************************************************
  1856.  *
  1857.  * ArrayNum()
  1858.  *
  1859.  * Return which array position we should look in when the user wants the
  1860.  * array member presented as a number of dimensions and an array with the
  1861.  * dimension sizes.
  1862.  *
  1863.  ******/
  1864.  
  1865. static long 
  1866. ArrayNum(long num,     /* number of dimensions specified */
  1867.          long dnum,    /* number of dimensions declared  */
  1868.          long *dims,   /* dimensions specified */
  1869.          long *decl)   /* declared dimension information */
  1870. {
  1871.   long i;
  1872.   long pos=0;
  1873.   long base=1;
  1874.   if(num!=dnum)
  1875.     /*
  1876.      * Then we can't get proper information!!!
  1877.      */
  1878.     return(-1);
  1879.   for(i=0; i<num; i++) {
  1880.     if(dims[i]>=decl[i])
  1881.       return(-1);
  1882.  
  1883.     pos+=dims[i]*base;
  1884.     base*=decl[i];
  1885.   }
  1886.   return(pos);
  1887. }
  1888.  
  1889.  
  1890. /**********************************************************
  1891.  *
  1892.  * CallFunction()
  1893.  *
  1894.  * Calls a function. Internal, external or inside!!
  1895.  *
  1896.  *******/
  1897.  
  1898. static ReturnCode INLINE CallFunction(struct Data *scr,
  1899.                                       struct fplArgument *pass,
  1900.                                       struct Identifier *ident)
  1901. {
  1902.   ReturnCode ret;
  1903.   if(ident && ident->flags&FPL_INSIDE_FUNCTION) {
  1904.     CALL(inside(scr, pass, ident));
  1905.   } else if(ident && ident->flags&FPL_INTERNAL_FUNCTION) {
  1906.     CALL(functions(pass));
  1907.   } else { /* if (EXTERNAL_FUNCTION) */
  1908.     pass->funcdata=ident?ident->data.external.data:(void *)NULL;
  1909.  
  1910. #if defined(AMIGA) && defined(SHARED)
  1911.     if(ret=CheckStack(scr, scr->stack_limit, scr->stack_margin)) {
  1912.       if(ret==1)
  1913.         return(FPLERR_OUT_OF_MEMORY);
  1914.       else
  1915.         return(FPLERR_OUT_OF_STACK);
  1916.     }
  1917. #endif
  1918.  
  1919.     if(ident && ident->data.external.func) {
  1920.       /*
  1921.        * If this is non-zero, a function specific function pointer
  1922.        * has been assigned to it! In that case we should call that
  1923.        * function instead of the traditional, global one!
  1924.        */
  1925.       CALL(InterfaceCall(scr, pass, ident->data.external.func));
  1926.     } else {
  1927.       CALL(InterfaceCall(scr, pass, scr->function));
  1928.     }
  1929.  
  1930.   }
  1931.   return(FPL_OK);
  1932. }
  1933.  
  1934. /**********************************************************************
  1935.  *
  1936.  * inside();
  1937.  *
  1938.  * This function takes care of the inside function callings within a
  1939.  * FPL program (or in a FPL program where the function was declared using
  1940.  * `export').
  1941.  *
  1942.  ******/
  1943.  
  1944. static ReturnCode INLINE inside(struct Data *scr,
  1945.                                 struct fplArgument *arg,
  1946.                                 struct Identifier *func)
  1947. {
  1948.   /*
  1949.    * The function has been declared as an `inside' one.
  1950.    */
  1951.   
  1952.   ReturnCode ret=FPL_OK;
  1953.   struct Identifier *pident; /* pointer to identifier */
  1954.   struct Identifier *ident;
  1955.   char *t=scr->text;
  1956.   struct Local *locals=NULL;
  1957.   long p=scr->prg;
  1958.   char *file=scr->prog->name;
  1959.   long vp=scr->virprg;
  1960.   char *vf=scr->virfile;
  1961.   char count; /* parameter counter */
  1962.   char *text;
  1963.   struct Condition con;
  1964.   struct Expr val;
  1965.   struct fplStr *string;
  1966.   char oldret;
  1967.   static unsigned long inttags[]={FPLSEND_INT, 0, FPLSEND_DONE};
  1968.   static unsigned long strtags[]={FPLSEND_STRING, 0, FPLSEND_STRLEN, 0,
  1969.                                     FPLSEND_DONE};
  1970.   char cont;
  1971.   long search;
  1972.   struct Program *prog=scr->prog;
  1973.   struct fplVariable *tempvar;
  1974.   
  1975.   if(file!=func->data.inside.file) {
  1976.     struct Program *prog=scr->programs;
  1977.     while(prog) {
  1978.       if(!strcmp(prog->name, func->data.inside.file))
  1979.         break;
  1980.       prog=prog->next;
  1981.     }
  1982.     if(prog) {
  1983.       CALL(LeaveProgram(scr, scr->prog));
  1984.       CALL(GetProgram(scr, prog));
  1985.       scr->prog=prog;
  1986.     } else
  1987.       return(FPLERR_INTERNAL_ERROR); /* This is a dead-end error! */
  1988.   }
  1989.   
  1990.   if(func->flags&FPL_INSIDE_NOTFOUND) {
  1991.     /*
  1992.      * We have no current information about where this function
  1993.      * is to be found. Search for it and store the location in
  1994.      * ->text and ->prg.
  1995.      */
  1996.     
  1997.     cont=TRUE;
  1998.     search=(func->data.inside.ret==FPL_STRARG)?CMD_STRING:
  1999.     (func->data.inside.ret==FPL_INTARG)?CMD_INT:CMD_VOID;
  2000.     
  2001.     /*
  2002.      * Start searching from the declaration position to enable local functions!
  2003.      */
  2004.     
  2005.     scr->text=(&scr->prog->program)[scr->prog->startprg-1]+
  2006.       func->data.inside.col;
  2007.     scr->prg=func->data.inside.prg;
  2008.     scr->virprg=func->data.inside.virprg;
  2009.     scr->virfile=func->data.inside.virfile;
  2010.     while(cont && !ret) {
  2011.       switch(*scr->text) {
  2012.       case CHAR_OPEN_BRACE:
  2013.         /* ...go to the corresponding brace */
  2014.         ret=GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, TRUE);
  2015.         break;
  2016.       case CHAR_OPEN_PAREN:
  2017.         /* ...go to the corresponding parenthesis */
  2018.         ret=GetEnd(scr, CHAR_CLOSE_PAREN, CHAR_OPEN_PAREN, TRUE);
  2019.         break;
  2020.       case CHAR_QUOTATION_MARK:
  2021.         scr->text++;
  2022.         /* dirty use of function: */
  2023.         ret=GetEnd(scr, CHAR_QUOTATION_MARK, CHAR_QUOTATION_MARK, FALSE);
  2024.         break;
  2025.       case CHAR_ASCII_ZERO:
  2026.         if(Newline(scr))
  2027.           ret=FPLERR_INSIDE_NOT_FOUND;
  2028.         break;
  2029.       case CHAR_DIVIDE: /* to eat comments */
  2030.       case CHAR_SPACE:
  2031.       case CHAR_TAB:
  2032.       case CHAR_NEWLINE:
  2033.         if(Eat(scr))
  2034.           ret=FPLERR_INSIDE_NOT_FOUND;
  2035.         if(*scr->text==CHAR_HASH) {
  2036.           /* This should read a #line statement for new virtual line number */
  2037.           while(*scr->text++!=CHAR_NEWLINE);
  2038.           scr->virprg++;
  2039.         }
  2040.         break;
  2041.       case CHAR_CLOSE_BRACE: /* local function searches might hit this! */
  2042.         ret=FPLERR_INSIDE_NOT_FOUND;
  2043.         break;
  2044.       default:
  2045.         if(ALPHA(*scr->text)) {
  2046.           Getword(scr->buf, scr);
  2047.           GetIdentifier(scr, scr->buf, &pident);
  2048.           if(pident && /* valid identifier */
  2049.              pident->data.external.ID==search) {  /* and it's the right one */
  2050.             if(!Getword(scr->buf, scr)) {
  2051.               GetIdentifier(scr, scr->buf, &pident);
  2052.               if(pident && pident->flags&FPL_INSIDE_FUNCTION) /* an inside */
  2053.                 cont=strcmp(pident->name, func->name); /* is it the right? */
  2054.             }
  2055.           } else
  2056.             while(ALPHA(*scr->text))
  2057.               scr->text++;
  2058.         } else
  2059.           scr->text++;
  2060.         break;
  2061.       }
  2062.     }
  2063.     if(ret) {
  2064.       strcpy(scr->buf, func->name); /* enable better error report! */
  2065.       scr->prg=p;
  2066.       scr->text=t;
  2067.       scr->virprg=vp;
  2068.       return(FPLERR_INSIDE_NOT_FOUND); /* dead end error */
  2069.     }
  2070.     func->data.inside.col=scr->text-(&scr->prog->program)[scr->prg-1];
  2071.     func->data.inside.prg=scr->prg;
  2072.     func->data.inside.virprg=scr->virprg;
  2073.     func->data.inside.virfile=scr->virfile;
  2074.     func->flags&=~FPL_INSIDE_NOTFOUND; /* we have found it! */
  2075.   } else {
  2076.     /*
  2077.      * We know where to find this function!
  2078.      */
  2079.     
  2080.     scr->prg=func->data.inside.prg;
  2081.     scr->text=(&scr->prog->program)[scr->prg-1]+func->data.inside.col;
  2082.     scr->virprg=func->data.inside.virprg;
  2083.     scr->virfile=func->data.inside.virfile;
  2084.   }
  2085.   
  2086.   /**********************************
  2087.    * PARSE THE PARAMETER LIST HERE! *
  2088.    **********************************/
  2089.   
  2090.   CALL(Eat(scr));
  2091.   
  2092.   if(*scr->text!=CHAR_OPEN_PAREN) {
  2093.     CALL(Warn(scr, FPLERR_MISSING_PARENTHESES));
  2094.     /* we can survive without that! */
  2095.   } else
  2096.     scr->text++;
  2097.  
  2098.   if(func->data.inside.format) {
  2099.     /*
  2100.      * We won't hit this if no arguments is prototyped.
  2101.      */
  2102.               
  2103.     count=0; /* parameter counter */
  2104.     text=func->data.inside.format;
  2105.     
  2106.     if(!*text) {
  2107.       if(!Getword(scr->buf, scr) && strcmp(scr->buf, "void")) {
  2108.         /* it should be "void" or nothing! If it wasn't we fail! */
  2109.         CALL(Warn(scr, FPLERR_ILLEGAL_DECLARE));
  2110.       }
  2111.     } else {
  2112.       while(*text && !ret) {
  2113.         CALL(Getword(scr->buf, scr));
  2114.         CALL(GetIdentifier(scr, scr->buf, &ident));
  2115.         switch(*text) {
  2116.         case FPL_STRARG:
  2117.         case FPL_INTARG:
  2118.           if(*text==FPL_STRARG &&
  2119.              ident->data.external.ID!=CMD_STRING) {
  2120.             CALL(Warn(scr, FPLERR_ILLEGAL_DECLARE));
  2121.             /* we create the variable that was declared in the prototype! */
  2122.           } else if(*text==FPL_INTARG &&
  2123.                     ident->data.external.ID!=CMD_INT) {
  2124.             CALL(Warn(scr, FPLERR_ILLEGAL_DECLARE));
  2125.             /* we create the variable that was declared in the prototype! */
  2126.           }
  2127.           /*
  2128.            * Declare the following word as a string or integer
  2129.            * variable.
  2130.            */
  2131.           GETMEM(pident, sizeof(struct Identifier));
  2132.             
  2133.           CALL(Getword(scr->buf, scr));
  2134.             
  2135.           /* OLD: GETMEM(tempvar, sizeof(struct fplVariable)); */
  2136.           tempvar=&pident->data.variable;
  2137.             
  2138.           pident->flags=(*text==FPL_INTARG?FPL_INT_VARIABLE:
  2139.                          FPL_STRING_VARIABLE)|
  2140.                            (ident->flags&FPL_VARIABLE_LESS32);
  2141.           
  2142.           STRDUP(pident->name, scr->buf);
  2143.             
  2144.           tempvar->num=0; /* This is not an array */
  2145.           tempvar->size=1; /* This is not an array */
  2146.           GETMEM(tempvar->var.val32, sizeof(void *));
  2147.           if(*text==FPL_INTARG) {
  2148.             tempvar->var.val32[0]=(long)arg->argv[count];
  2149.           } else {
  2150.             /* Store string length in variable `len' */
  2151.             register long len=GETSTRLEN(arg->argv[count]);
  2152.             GETMEM(tempvar->var.str[0], sizeof(struct fplStr)+len);
  2153.             tempvar->var.str[0]->alloc=len;
  2154.   
  2155.             /* We copy the ending zero termination too! */
  2156.             memcpy(tempvar->var.str[0]->string, ((char *)arg->argv[count]), len+1);
  2157.             tempvar->var.str[0]->len=len;
  2158.           }
  2159.           /*
  2160.            * Emulate next level variable declaration by adding one
  2161.            * to the ->level member here... dirty but (fully?)
  2162.            * functional!!!! ;-)
  2163.            */
  2164.             
  2165.           pident->level=scr->varlevel+1;
  2166.           pident->file=scr->prog->name;
  2167.           pident->func=func;
  2168.           CALL(AddVar(scr, pident, &locals));
  2169.           break;
  2170.         case FPL_STRVARARG:
  2171.         case FPL_INTVARARG:
  2172.           if(*text==FPL_STRVARARG && ident->data.external.ID!=CMD_STRING) {
  2173.             CALL(Warn(scr, FPLERR_ILLEGAL_DECLARE));
  2174.             /* create a string reference anyway! */
  2175.           } else if(*text==FPL_INTVARARG && ident->data.external.ID!=CMD_INT) {
  2176.             CALL(Warn(scr, FPLERR_ILLEGAL_DECLARE));
  2177.             /* create an int reference anyway! */
  2178.           }
  2179.           else CALL(Eat(scr));
  2180.           else if(*scr->text!=CHAR_AND) {
  2181.             /* if it's not a proper reference sign here, warn! */
  2182.             CALL(Warn(scr, FPLERR_ILLEGAL_PROTOTYPE));
  2183.             /* keep it up anyway! */
  2184.           }
  2185.           /*
  2186.            * Declare the following word as a variable which
  2187.            * will use the struct fplVariable pointer as given in the
  2188.            * calling parameter list.
  2189.            */
  2190.           
  2191.           scr->text++;
  2192.           CALL(Getword(scr->buf, scr));
  2193.             
  2194.           if(arg->argv[count]) {
  2195.             /*
  2196.              * If the wrong kind of variable was sent in the function call, no
  2197.              * varible will be sent, and no one will be declared.
  2198.              */
  2199.   
  2200.             GETMEM(pident, sizeof(struct Identifier));
  2201.   
  2202.             *pident=*(struct Identifier *)arg->argv[count];
  2203.             pident->flags|=FPL_COPIED_DATA;
  2204.             pident->data.variable.temp=
  2205.               &((struct Identifier *)arg->argv[count])->data.variable;
  2206.             /* original fplVariable position */
  2207.   
  2208.             STRDUP(pident->name, scr->buf);
  2209.   
  2210.             pident->level=scr->varlevel+1;
  2211.             pident->file=scr->prog->name;
  2212.             pident->func=func;
  2213.             CALL(AddVar(scr, pident, &locals));
  2214.           }
  2215.           break;
  2216.         }
  2217.         CALL(Eat(scr));
  2218.   
  2219.         if(*++text && *scr->text++!=CHAR_COMMA)
  2220.           /*
  2221.            * There is no way out from this error exception. Leaving a parameter
  2222.            * really is a sever thing!
  2223.            */
  2224.           return(FPLERR_MISSING_ARGUMENT);
  2225.         count++;
  2226.       }
  2227.     }
  2228.     
  2229.     CALL(Eat(scr));
  2230.     
  2231.     if(*scr->text!=CHAR_CLOSE_PAREN) {
  2232.       CALL(Warn(scr, FPLERR_ILLEGAL_DECLARE));
  2233.       /* who needs ending parentheses? */
  2234.     } else
  2235.       scr->text++;
  2236.   } else {
  2237.     /*
  2238.      * No argument is useable to this function. There might be a
  2239.      * `void' keyword here, but nothing else! Just search for the
  2240.      * closing parenthesis to fasten interpreting!
  2241.      */
  2242.     
  2243.     if(ret=GetEnd(scr, CHAR_CLOSE_PAREN, CHAR_OPEN_PAREN, FALSE)) {
  2244.       CALL(Warn(scr, FPLERR_MISSING_PARENTHESES));
  2245.       /* ok, then search for the open brace where the program starts! */
  2246.       ret=GetEnd(scr, CHAR_OPEN_BRACE, CHAR_OPEN_PAREN, FALSE);
  2247.       if(ret) {
  2248.         CALL(Warn(scr, FPLERR_MISSING_BRACE));
  2249.       } else
  2250.         scr->text--; /* back on brace */    
  2251.       /* ok, then we say that the program starts right here! */      
  2252.     }
  2253.   }
  2254.   
  2255.   /*********************
  2256.    * RUN THE FUNCTION! *
  2257.    *********************/
  2258.   
  2259.   oldret=scr->strret;
  2260.   scr->strret=func->data.inside.ret==FPL_STRARG; /* should we receive a string? */
  2261.   CALL(Eat(scr));
  2262.   if(*scr->text!=CHAR_OPEN_BRACE) {
  2263.     CALL(Warn(scr, FPLERR_MISSING_BRACE));
  2264.     /* we can do with a start without it! */
  2265.   } else
  2266.     scr->text++;
  2267.  
  2268.   con.bracetext=scr->text;
  2269.   con.braceprg=scr->prg;
  2270.   text=(void *)scr->func; /* backup current */
  2271.   scr->func=func;
  2272.  
  2273.   scr->prog->openings++;
  2274.   ret=Script(scr, &val, SCR_BRACE|SCR_FUNCTION, &con);
  2275.   scr->prog->openings--;
  2276.  
  2277.   /*
  2278.    * Delete all variables created on our list for use
  2279.    * only in the function we just came back from!
  2280.    */
  2281.   DelLocalVar(scr, &locals);
  2282.  
  2283.   if(ret)
  2284.     return(ret);
  2285.  
  2286.   scr->func=(void *)text; /* restore last */
  2287.  
  2288.   if(scr->strret) {
  2289.     /* we should return a string */
  2290.     string=val.val.str;
  2291.  
  2292.     strtags[1]=(long)string->string;
  2293.     strtags[3]=string->len;
  2294.     CALL(fplSend(scr, strtags));
  2295.     FREE(string);
  2296.   } else {
  2297.     inttags[1]=val.val.val;
  2298.     CALL(fplSend(scr, inttags));
  2299.   }
  2300.  
  2301.   scr->text=t;
  2302.   scr->prg=p;
  2303.   scr->virprg=vp;
  2304.   scr->virfile=vf;
  2305.   scr->strret=oldret;
  2306.   if(scr->prog!=prog) {
  2307.     CALL(LeaveProgram(scr, scr->prog));
  2308.     scr->prog=prog;
  2309.     CALL(GetProgram(scr, scr->prog));
  2310.   }
  2311.   return(FPL_OK);
  2312. }
  2313.  
  2314. static ReturnCode INLINE PrototypeInside(struct Data *scr,
  2315.                      struct Expr *val,
  2316.                      long control,
  2317.                      struct Identifier *ident)
  2318. {
  2319.   /*
  2320.    * Prototyping an `inside' function!
  2321.    *
  2322.    * We have already received the return type, now we must
  2323.    * parse the paraters given within the parentheses. Legal
  2324.    * parameters are only combinations of `string', `int',
  2325.    * `string &' and `int &', or a single `void' (if no argument
  2326.    * should be sent to the function). Arguments specified in
  2327.    * a prototype is required, there is no way to specify an
  2328.    * optional parameter or a parameter list.
  2329.    */
  2330.  
  2331.   struct Identifier *pident, *wident;
  2332.   long pos=0;
  2333.   ReturnCode ret = FPL_OK;
  2334.   char *array;
  2335.   char found=ident?TRUE:FALSE;
  2336.  
  2337.   /* For compiling: */
  2338.   struct Local *locals=NULL;
  2339.   struct fplVariable *tempvar;
  2340.   
  2341.   if(!found) {
  2342.     GETMEM(pident, sizeof(struct Identifier));
  2343.     STRDUP(pident->name, scr->buf);
  2344.   } else {
  2345.     /* we already know about this function! */
  2346.     if(ident->flags&(FPL_INTERNAL_FUNCTION|FPL_KEYWORD|FPL_EXTERNAL_FUNCTION))
  2347.       return FPLERR_IDENTIFIER_USED;
  2348.     pident = ident;
  2349.   }
  2350.  
  2351.   if(!found || (found && ident->flags&FPL_INSIDE_NOTFOUND)) {
  2352.     /* we know where this is... */
  2353.     pident->data.inside.col=scr->text-(&scr->prog->program)[scr->prg-1];
  2354.     pident->data.inside.prg=scr->prg;
  2355.     pident->data.inside.file=scr->prog->name;
  2356.     pident->data.inside.virprg=scr->virprg;
  2357.     pident->data.inside.virfile=scr->virfile;
  2358.     
  2359.     pident->file=control&CON_DECLEXP?NULL:scr->prog->name; /* file! */
  2360.     pident->func=scr->func; /* declared in this function */
  2361.     pident->level=control&CON_DECLGLOB?0:scr->varlevel;
  2362.   }
  2363.  
  2364.   if(found) {
  2365.     /* we already know about this function! */
  2366.  
  2367.     CALL(GetEnd(scr, CHAR_CLOSE_PAREN, CHAR_OPEN_PAREN, TRUE));
  2368.  
  2369.     CALL(Eat(scr));
  2370.  
  2371.     if(scr->text[0]==CHAR_OPEN_BRACE) {
  2372.       /* now the function is found! */
  2373.       if(!(ident->flags&FPL_INSIDE_NOTFOUND))
  2374.         /* the function has already been defined and is defined here again! */
  2375.         return FPLERR_IDENTIFIER_USED;
  2376.  
  2377.       ident->flags&=~FPL_INSIDE_NOTFOUND;
  2378.  
  2379.       CALL(GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, TRUE));
  2380.       scr->text--; /* back on close brace */
  2381.       val->flags|=FPL_DEFUNCTION;
  2382.     }
  2383.  
  2384.     return FPL_OK;
  2385.   }
  2386.  
  2387.   pident->flags=FPL_INSIDE_FUNCTION|
  2388.     (control&CON_DECLEXP?FPL_EXPORT_SYMBOL:0);
  2389.  
  2390.   scr->text++; /* pass the open parenthesis */
  2391.  
  2392.   if(scr->compiling)
  2393.     COMPILE(COMP_START_OF_PARAMETERS);          
  2394.  
  2395.   CALL(Eat(scr));
  2396.  
  2397.   GETMEM(array, MAX_ARGUMENTS * sizeof(char));
  2398.           
  2399.   while(pos<MAX_ARGUMENTS) {
  2400.     if(*scr->text==CHAR_CLOSE_PAREN) {
  2401.       scr->text++;
  2402.       break;
  2403.     }
  2404.     CALL(Getword(scr->buf, scr));
  2405.     CALL(GetIdentifier(scr, scr->buf, &ident));
  2406.     CALL(Eat(scr));
  2407.     switch(ident->data.external.ID) {
  2408.     case CMD_VOID:
  2409.       if(scr->compiling)
  2410.         COMPILE(COMP_NO_PARAMETER);
  2411.       if(*scr->text!=CHAR_CLOSE_PAREN) {
  2412.         CALL(Warn(scr, FPLERR_ILLEGAL_PROTOTYPE));
  2413.         CALL(GetEnd(scr, CHAR_CLOSE_PAREN, CHAR_OPEN_PAREN, TRUE));
  2414.       } else
  2415.         scr->text++;
  2416.       break;
  2417.  
  2418.     case CMD_STRING:
  2419.     case CMD_INT:
  2420.       if(*scr->text==CHAR_AND) {
  2421.         scr->text++;
  2422.         if(scr->compiling)
  2423.           COMPILE(COMP_VARIABLEREF);
  2424.         array[pos]=(ident->data.external.ID==CMD_STRING)?FPL_STRVARARG:
  2425.           FPL_INTVARARG;
  2426.       } else
  2427.         array[pos]=(ident->data.external.ID==CMD_STRING)?FPL_STRARG:
  2428.           FPL_INTARG;
  2429.       if(scr->compiling) {
  2430.         if(ident->data.external.ID==CMD_STRING)
  2431.           COMPILE(COMP_STRING_PARAMETER);
  2432.         else
  2433.           COMPILE(COMP_INT_PARAMETER);
  2434.  
  2435.         if(ALPHA(*scr->text)) {
  2436.           Getword(scr->buf, scr);
  2437.  
  2438.           COMPILESYMBOL(scr->buf);
  2439.  
  2440.           /*
  2441.            * Declare that word as a string or integer variable.
  2442.            */
  2443.           GETMEM(wident, sizeof(struct Identifier));
  2444.             
  2445.           tempvar=&wident->data.variable;
  2446.             
  2447.           wident->flags=(ident->data.external.ID==CMD_INT)?FPL_INT_VARIABLE:
  2448.                          FPL_STRING_VARIABLE|
  2449.                            (ident->flags&FPL_VARIABLE_LESS32);
  2450.           
  2451.           STRDUP(wident->name, scr->buf);
  2452.             
  2453.           tempvar->num=0; /* This is not an array */
  2454.           tempvar->size=1; /* This is not an array */
  2455.           GETMEM(tempvar->var.val32, sizeof(void *));
  2456.           if(ident->data.external.ID==CMD_INT) {
  2457.             tempvar->var.val32[0]=(long)0;
  2458.           } else {
  2459.             GETMEM(tempvar->var.str[0], sizeof(struct fplStr));
  2460.             memset(tempvar->var.str[0], 0, sizeof(struct fplStr));
  2461.           }
  2462.           /*
  2463.            * Emulate next level variable declaration by adding one
  2464.            * to the ->level member here... dirty but (fully?)
  2465.            * functional!!!! ;-)
  2466.            */
  2467.             
  2468.           wident->level=scr->varlevel+1;
  2469.           wident->file=scr->prog->name;
  2470.           wident->func=scr->func;
  2471.           CALL(AddVar(scr, wident, &locals));
  2472.  
  2473.         }
  2474.         CALL(Eat(scr));
  2475.       }
  2476.       break;
  2477.  
  2478.     default:
  2479.       CALL(Warn(scr, FPLERR_ILLEGAL_PROTOTYPE));
  2480.       continue; /* if we against all odds are ordered to go on! */
  2481.     }
  2482.     if(CMD_VOID == ident->data.external.ID)
  2483.       break;
  2484.  
  2485.     pos++;
  2486.     if(ALPHA(*scr->text)) {
  2487.       Getword(scr->buf, scr);
  2488.       CALL(Eat(scr));
  2489.     }
  2490.  
  2491.     if(*scr->text==CHAR_COMMA)
  2492.       scr->text++;
  2493.     else if(*scr->text!=CHAR_CLOSE_PAREN) {
  2494.       CALL(Warn(scr, FPLERR_ILLEGAL_PROTOTYPE));
  2495.       /* we can go on if we just forgot the closing parenthesis */
  2496.     }
  2497.   }
  2498.  
  2499.   array[pos]=0; /* terminate string */
  2500.  
  2501.   /*
  2502.    * We have all information now. AddIdentifier().
  2503.    */
  2504.  
  2505.   pident->data.inside.ret=(control&CON_DECLSTR)?FPL_STRARG:
  2506.     (control&CON_DECLINT)?FPL_INTARG:FPL_VOIDARG;
  2507.   GETMEM(pident->data.inside.format, pos+1);
  2508.   strcpy(pident->data.inside.format, array);
  2509.   FREE(array);
  2510.  
  2511.   CALL(Eat(scr)); /* Eat white space */
  2512.  
  2513.  
  2514.   if(scr->compiling)
  2515.     COMPILE(COMP_END_OF_PARAMETERS);          
  2516.  
  2517.   if(*scr->text==CHAR_OPEN_BRACE) {
  2518.     /* It's the actual function!!! */
  2519.     if(!scr->compiling) {
  2520.       CALL(GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, TRUE));
  2521.       scr->text--; /* back on close brace */
  2522.     }
  2523.     val->flags|=FPL_DEFUNCTION;
  2524.   } else {
  2525.     val->flags&=~FPL_DEFUNCTION;
  2526.     pident->flags|=FPL_INSIDE_NOTFOUND;
  2527.   }
  2528.   CALL(AddVar(scr, pident,
  2529.               control&CON_DECLGLOB?&scr->globals:&scr->locals));
  2530.   if(scr->compiling) {
  2531.     if(val->flags&FPL_DEFUNCTION) {
  2532.       struct Condition con;
  2533.       struct Expr expr;
  2534.       scr->text++; /* pass the open brace! */
  2535.       COMPILE(COMP_START_OF_BLOCK);
  2536.       ret = Script(scr, &expr, SCR_BRACE|SCR_FUNCTION, &con);
  2537.       if(!ret)
  2538.         scr->text--; /* back on close brace */
  2539.       val->flags|=FPL_DEFUNCTION;
  2540.     }
  2541.     /*
  2542.      * Delete all variables created on our list for use
  2543.      * only in the function we just came back from!
  2544.      */
  2545.     DelLocalVar(scr, &locals);
  2546.  
  2547.   }
  2548.  
  2549.   return(ret);
  2550. }
  2551.